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

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

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.

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 comment les données de vos commentaires sont utilisées.