Copier du contenu dans le presse-papier avec VBA - la meilleure approche que j'ai trouvée

Voici une question qui revient souvent dès que vous voulez :

  • Copier un message dans le presse-papier, par exemple pour ajouter à un e-mail
  • Copier des plages de cellules dans le presse-papier sous forme de texte

Le code de base pour copier un contenu dans le presse-papier

Voici le code tiré de ExcelHero.com

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Function Clipboard(Optional StoreText As String) As String
'PURPOSE: Read/Write to Clipboard
'Source: ExcelHero.com (Daniel Ferry)
 
If StoreText = "" Then Exit Function
 
 
Dim x As Variant
 
'Store as variant for 64-bit VBA support
  x = StoreText
 
'Create HTMLFile Object
  With CreateObject("htmlfile")
    With .parentWindow.clipboardData
      Select Case True
        Case Len(StoreText)
          'Write to the clipboard
            .setData "text", x
        Case Else
          'Read from the clipboard (no variable passed through)
            Clipboard = .GetData("text")
      End Select
    End With
  End With
 
End Function

Une fois le code copié dans votre classeur, on peut ensuite facilement l'utiliser.

Voici comment copier directement du texte dans le presse-papier

1
2
3
Sub TestClipBoardTexte()
Clipboard "Le texte à mettre dans le presse-papier."
End Sub

Aller plus loin en gérant des plages multiples et en testant que l'on soit bien sur une plage

Le code suivant utilise deux fonctions qui vont tester si la sélection est une plage et qui vont convertir une plage en texte (écrit avec ChatGPT). Pour le moment, je ne gère pas la sélection de plages multiples.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub testClipboard()
    If IsSelectionRange Then
        Clipboard RangeToTabDelimitedText(Selection)
    Else
        MsgBox "La sélection n'est pas une plage", vbOKOnly
    End If
End Sub
 
 
Function RangeToTabDelimitedText(rng As Range) As String
    Dim r As Long, c As Long
    Dim cell As Range
    Dim sResult As String
     
    For r = 1 To rng.Rows.Count
        For c = 1 To rng.Columns.Count
            Set cell = rng.Cells(r, c)
            sResult = sResult & cell.Text
            If c < rng.Columns.Count Then
                sResult = sResult & vbTab
            End If
        Next c
        If r < rng.Rows.Count Then
            sResult = sResult & vbCrLf
        End If
    Next r
     
    RangeToTabDelimitedText = sResult
End Function
 
Function IsSelectionRange() As Boolean
    On Error Resume Next
    Dim rng As Range
    Set rng = Application.Selection
    If Err.Number = 0 Then
        IsSelectionRange = True
    Else
        IsSelectionRange = False
    End If
    Err.Clear
    On Error GoTo 0
End Function
Pour marque-pages : Permaliens.

Laisser un commentaire

Votre adresse e-mail ne sera pas publiée. Les champs obligatoires sont indiqués avec *


La période de vérification reCAPTCHA a expiré. Veuillez recharger la page.

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur la façon dont les données de vos commentaires sont traitées.