XL 2010 Coller Presse-Papier dans module

cathodique

cathodique

XLDnaute Barbatruc
Bonjour,

Dans la suite de cette discussion , j'essaie de me faire un outil pour retrouver facilement mes bouts de codes.
Via une textbox, mes fichiers macros sont dans un premier temps filtrer dans une listbox1.
Au clic, sur un fichier ses lignes de code sont récupérées dans une autre listbox2.
J'utilise un code trouvé sur le net (si mes souvenirs sont bons: faq dvp) pour copier la listbox2 dans le presse-papier.
Je n'ai pas trouvé de solution pour copier le presse-papier dans un module actif (standard ou feuille ou classe, ect...).
Toute proposition est la bienvenue.
Avec mes remerciements anticipés.
Bon dimanche.
 
Dernière édition:
Trier par date Trier par votes
Dudu2

Dudu2

XLDnaute Barbatruc
Bonjour,
Pour le presse-papier j'ai ça:
VB: 
'-------------------------------------------------
'Placer une chaine de caractères dans le Clipboard
'-------------------------------------------------
'Pour utiliser le type DataObject il faut avoir la référence de "Microsoft Forms 2.0 Object Library"
'dans les références du Projet VBA (VBA / Outils / References [/ Parcourir si besoin]).
'S'il faut parcourir, aller dans C:\Windows\SysWOW64\FM20.DLL pour trouver cette référence !
'-------------------------------------------------
Sub PutInClipBoard(Chaine As String)
    Dim DataObject As New MSForms.DataObject
    
    With DataObject
        .SetText Chaine
        .PutInClipBoard
    End With
    
    Set DataObject = Nothing
End Sub

'---------------------------
'Check the Clipboard content
'---------------------------
Function GetFromClipBoard() As String
    Dim DataObject As New MSForms.DataObject
    
    With DataObject
        .GetFromClipBoard
        On Error Resume Next
        GetFromClipBoard = .GetText
        On Error GoTo 0
    End With
    
    Set DataObject = Nothing
End Function

'---------------------------
'Effacement du presse-papier
'---------------------------
Sub ClearClipboard()
    Dim DataObject As New MSForms.DataObject
    
    With DataObject
        .SetText ""
        .PutInClipBoard
    End With
    
    Set DataObject = Nothing
End Sub
Pour la création de module tu trouves facilement sur les forums.
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
Dudu2 à dit:
Bonjour,
Pour le presse-papier j'ai ça:
VB: 
'-------------------------------------------------
'Placer une chaine de caractères dans le Clipboard
'-------------------------------------------------
'Pour utiliser le type DataObject il faut avoir la référence de "Microsoft Forms 2.0 Object Library"
'dans les références du Projet VBA (VBA / Outils / References [/ Parcourir si besoin]).
'S'il faut parcourir, aller dans C:\Windows\SysWOW64\FM20.DLL pour trouver cette référence !
'-------------------------------------------------
Sub PutInClipBoard(Chaine As String)
    Dim DataObject As New MSForms.DataObject
   
    With DataObject
        .SetText Chaine
        .PutInClipBoard
    End With
   
    Set DataObject = Nothing
End Sub

'---------------------------
'Check the Clipboard content
'---------------------------
Function GetFromClipBoard() As String
    Dim DataObject As New MSForms.DataObject
   
    With DataObject
        .GetFromClipBoard
        On Error Resume Next
        GetFromClipBoard = .GetText
        On Error GoTo 0
    End With
   
    Set DataObject = Nothing
End Function

'---------------------------
'Effacement du presse-papier
'---------------------------
Sub ClearClipboard()
    Dim DataObject As New MSForms.DataObject
   
    With DataObject
        .SetText ""
        .PutInClipBoard
    End With
   
    Set DataObject = Nothing
End Sub
Pour la création de module tu trouves facilement sur les forums.
Cliquez pour agrandir...
Bonjour Dudu2 ;),

Merci pour ton partage. Je vais voir ce que je pourrais en tirer.
Je ne cherche pas à créer des modules.
En fait, je voudrai coller le contenu de la listbox2 où je veux. Dans le même style Ctrl+C et Ctrl+V.

Ce n'est pas encore gagné. Encore merci, pour ton partage.

Bon dimanche.
 
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
Une fonction généraliste qui accepte une ListBox ou ComboBox de feuille ou de UserForm:
VB: 
Sub MaListBoxEnClipBoard()
    Call CopierListBoxEnClipBoard(ActiveSheet.ListBox1)
    'Call CopierListBoxEnClipBoard(ActiveSheet.ComboBox1)
 
    'UserForm1.Show vbModeless
    'Call CopierListBoxEnClipBoard(UserForm1.ListBox1)
    'Call CopierListBoxEnClipBoard(UserForm1.ComboBox1)
End Sub

'-------------------------------------------------------
'Copie le contenu d'une ListBox ou ComboBox en ClipBoard
'-------------------------------------------------------
Sub CopierListBoxEnClipBoard(ListBoxOuComboBox As Object, _
                             Optional SéparateurLigne As String = vbCrLf, _
                             Optional SéparateurColonne As String = ", ")
    Dim ObjBox As Object
    Dim Texte As String
    Dim i As Integer
    Dim j As Integer
 
    'Contrôle ListBox ou ComboBox
    If Not (TypeOf ListBoxOuComboBox Is MSForms.ListBox Or TypeOf ListBoxOuComboBox Is MSForms.ComboBox) Then
        MsgBox "Erreur fonction CopierListBoxEnClipBoard()" & vbCrLf & _
               "L'argument n'est pas une ListBox ou une ComboBox."
        Exit Sub
    End If
 
    'Initialisation
    Texte = ""

    'Le Parent est une feuille => OLEObject
    If TypeOf ListBoxOuComboBox.Parent Is Worksheet Then
        Set ObjBox = Workbooks(ListBoxOuComboBox.Parent.Parent.Name) _
                    .Worksheets(ListBoxOuComboBox.Parent.Name) _
                    .OLEObjects(ListBoxOuComboBox.Name).Object
    
    'Le Parent n'est pas une feuille => UserForm Control
    Else
        Set ObjBox = ListBoxOuComboBox
    End If
 
    'Scan des lignes de la ListBox
    For i = 0 To ObjBox.ListCount - 1
        Texte = Texte & IIf(Len(Texte), SéparateurLigne, "")
    
        'Scan des colonnes de la ListBox
        For j = 0 To ObjBox.ColumnCount - 1
           Texte = Texte & IIf(j > 0, SéparateurColonne, "") & ObjBox.List(i, j)
        Next j
    Next i
 
    'Mise en ClipBoard
    Call PutInClipBoard(Texte)
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour cathodique, Dudu2,

J'ai quelque peu modifié le code de l'USF :
VB: 
Dim repertoire$, Tb$()

Private Sub CbCopier_Click()
    If ListBox2.ListIndex = -1 Then MsgBox "Une ligne doit être sélectionnée dans ListBox2...": Exit Sub
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' DataObject en late binding
        .SetText ListBox2
        .PutInClipboard
    End With
    [D3].Select
    ActiveSheet.Paste 'pour tester, colle le contenu du presse-papiers en D3
End Sub

Private Sub TextBox1_Change()
    If Tb(0) <> "" Then ListBox1.List = Filter(Tb, TextBox1, True, vbTextCompare)
End Sub

Private Sub UserForm_Initialize() 'Sylvanu
    Dim MyFile$, n&
    repertoire = ThisWorkbook.Path & "\1MesMacros\"
    MyFile = Dir(repertoire)
    ListBox1.Clear
    ReDim Tb(0)
    While MyFile <> ""
        If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(MyFile, 4) & "/") Then
            ReDim Preserve Tb(n)
            Tb(n) = MyFile
            n = n + 1
        End If
        MyFile = Dir
    Wend
    If n Then ListBox1.List = Tb
End Sub

Private Sub ListBox1_Click()
    Dim IdFile%, TextLine$, a$(), n&
    ListBox2.Clear
    IdFile = FreeFile
    Open repertoire & "\" & ListBox1 For Input As #IdFile
    While Not EOF(IdFile)
        Line Input #IdFile, TextLine
        ReDim Preserve a(n): a(n) = TextLine: n = n + 1
    Wend
    If n Then ListBox2.List = a
    Close #IdFile
End Sub
Le contenu du presse-papiers peut être collé où l'on veut via Ctrl+V.

Edit : ajouté If Tb(0) <> "" Then dans TextBox1_Change (s'il n'y a aucun fichier).

A+
 

Pièces jointes

  • Archive_VBA(1).xlsm
    24.8 KB · Affichages: 10
Dernière édition:
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
job75 à dit:
Bonjour cathodique, Dudu2,

J'ai quelque peu modifié le code de l'USF :
VB: 
Dim repertoire$, Tb$()

Private Sub CbCopier_Click()
    If ListBox2.ListIndex = -1 Then MsgBox "Une ligne doit être sélectionnée dans ListBox2...": Exit Sub
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' DataObject en late binding
        .SetText ListBox2
        .PutInClipboard
    End With
    [D3].Select
    ActiveSheet.Paste 'pour tester, colle le contenu du presse-papiers en D3
End Sub

Private Sub TextBox1_Change()
    If Tb(0) <> "" Then ListBox1.List = Filter(Tb, TextBox1, True, vbTextCompare)
End Sub

Private Sub UserForm_Initialize() 'Sylvanu
    Dim MyFile$, n&
    repertoire = ThisWorkbook.Path & "\1MesMacros\"
    MyFile = Dir(repertoire)
    ListBox1.Clear
    ReDim Tb(0)
    While MyFile <> ""
        If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(MyFile, 4) & "/") Then
            ReDim Preserve Tb(n)
            Tb(n) = MyFile
            n = n + 1
        End If
        MyFile = Dir
    Wend
    If n Then ListBox1.List = Tb
End Sub

Private Sub ListBox1_Click()
    Dim IdFile%, TextLine$, a$(), n&
    ListBox2.Clear
    IdFile = FreeFile
    Open repertoire & "\" & ListBox1 For Input As #IdFile
    While Not EOF(IdFile)
        Line Input #IdFile, TextLine
        ReDim Preserve a(n): a(n) = TextLine: n = n + 1
    Wend
    If n Then ListBox2.List = a
    Close #IdFile
End Sub
Le contenu du presse-papiers peut être collé où l'on veut via Ctrl+V.

Edit : ajouté If Tb(0) <> "" Then dans TextBox1_Change (s'il n'y a aucun fichier).

A+
Cliquez pour agrandir...
Bonsoir Job75,

Je te suis reconnaissant. Je garde aussi ton fichier car il pourrait me servir pour extraire mes bouts de code ligne par ligne au besoin.
Mon idée initiale était de faire un copier/coller de toutes les lignes de la Listbox.
Dans mon fichier final, je mettrai les 2 formulaires l'un pour avoir tout le code et l'autre par une ligne de code.

Encore merci pour le temps que tu m'as consacré.

Bonne soirée.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
cathodique à dit:
Mon idée initiale était de faire un copier/coller de toutes les lignes de la Listbox.
Cliquez pour agrandir...
Alors cette macro qui concatène tous les éléments de ListBox2, fichier (2) :
VB: 
Private Sub CbCopier_Click()
    If ListBox2.ListCount = 0 Then Exit Sub
    Dim a, i&, x$
    a = ListBox2.List
    For i = 0 To UBound(a)
        x = x & vbLf & a(i, 0) 'concaténation avec renvoi à la ligne
    Next
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' DataObject en late binding
        .SetText Mid(x, 2)
        .PutInClipboard
    End With
    With [D3]
        .Select
        .Parent.Paste 'pour tester, colle le contenu du presse-papiers en D3 et cellules suivantes
        .Offset(UBound(a) + 1).Resize(Rows.Count - UBound(a) - .Row).ClearContents 'RAZ en dessous
    End With
End Sub
 

Pièces jointes

  • Archive_VBA(2).xlsm
    26.2 KB · Affichages: 11
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
job75 à dit:
Alors cette macro qui concatène tous les éléments de ListBox2, fichier (2) :
VB: 
Private Sub CbCopier_Click()
    If ListBox2.ListCount = 0 Then Exit Sub
    Dim a, i&, x$
    a = ListBox2.List
    For i = 0 To UBound(a)
        x = x & vbLf & a(i, 0) 'concaténation avec renvoi à la ligne
    Next
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' DataObject en late binding
        .SetText Mid(x, 2)
        .PutInClipboard
    End With
    With [D3]
        .Select
        .Parent.Paste 'pour tester, colle le contenu du presse-papiers en D3 et cellules suivantes
        .Offset(UBound(a) + 1).Resize(Rows.Count - UBound(a) - .Row).ClearContents 'RAZ en dessous
    End With
End Sub
Cliquez pour agrandir...
Bonjour Job75,

Très gentil de ta part. Fonctionne parfaitement. Merci.
Une dernière question: Est-ce que la ligne de code ci-dessous est compatible avec toutes les versions d'Excel?
VB: 
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' DataObject en late binding

Bonne journée.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
tu a celle ci aussi
VB: 
Private Sub CbCopier_Click()
    If ListBox2.ListCount = 0 Then Exit Sub
    With Application
        CreateObject("htmlfile").parentWindow.clipboardData.setData "Text", Join(.Transpose(.Index(ListBox2.List, 0, 1)), vbCrLf)
    End With

    With [D3]
        .Select
        .Parent.Paste    'pour tester, colle le contenu du presse-papiers en D3 et cellules suivantes
        .Offset(ListBox2.ListCount + 1).Resize(Rows.Count - ListBox2.ListCount - .Row).ClearContents    'RAZ en dessous
    End With
End Sub
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
patricktoulon à dit:
Bonjour cathodique
oui c'est compatible avec toute version d'excel
c'est la création du dataobject en late binding

a tester sur Mac j'en suis pas sur en latebinding
Cliquez pour agrandir...
Bonjour PatrickToulon:),

Merci pour ta confirmation. Stp, pourrais-tu apporter ta contribution à mon petit projet qui me permettra de retrouver assez facilement mes bouts de codes.

Le fichier de Job75 fonctionne bien (post#9). Mes fichiers de codes sont stockés dans le répertoire 1MesMacros .
J'ai voulu classer les fichiers dans des sous-dossiers par catégories. Et, là c'est la cata...
J'ai réussi à lister mes fichiers (dossier et sous-dossiers) avec ce code
VB: 
Private Sub UserForm_Initialize()
    Dim n&, Dossier As Object, Fichier As Object, chemin As String
    ListBox1.Clear
    ReDim Tb(0)
    'Chemin du dossier à analyser (à adapter au besoin)
    chemin = ThisWorkbook.Path & "\1MesMacros"
    'Définition de la variable
    Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(chemin)
    ' Boucle sur les fichiers
    For Each Fichier In Dossier.Files
        If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(Fichier, 4) & "/") Then
            ReDim Preserve Tb(n)
            Tb(n) = Fichier.Name
            n = n + 1
        End If
        If n Then ListBox1.List = Tb
    Next
End Sub
Je n'ai pas encore réussi à récupérer le chemin du fichier sélectionné afin afficher le contenu du fichier dans la listbox2.

Merci.

Bonne journée.

edit: pas vu ton dernier post. Merci beaucoup.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
c'est fichier.path et non fichier.name
mais comme c'est pas pratique si le path est long je mettrais une 2d colonne moi dans ma liste caché si il faut dans le quel je stoke le path complet
et je vois nul part la récursivité pour les sous dossiers donc tu n'a que les fichiers enfants direct du dossier en paramètre qui sont listés
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
voici un exemple complet
tu a un userform avec deux listbox et deux boutons
la listbox1 liste tout les fichier dans le dossierMaitre et tout ses sous dossiers
la listbox2 liste le code lu dans le fichiers cliqué dans la listbox1
tu a une constante en haut de module userform
ADAPTE LE CHEMIN DE TON DOSSIER MAITRE pour cette constante

ben y a plus qu'a
demo7.gif
 

Pièces jointes

  • exemple pour cathodique.xlsm
    26.2 KB · Affichages: 3
Vote positif 0 Vote négatif

Discussions similaires

R
  • Question
Autres Copie dans le presse-papier d'une sélection multiple
2
Réponses
16
Affichages
823
Renaud22
R
C
  • Question
XL 2016 Coller plusieurs fichiers 'entiers' dans le presse papier
2 3
Réponses
37
Affichages
2 K
TooFatBoy
TooFatBoy
Usine à gaz
  • Résolu(e)
Autres tester si le Presse Papier (Clipboard) esi vide
2
Réponses
27
Affichages
797
Usine à gaz
Usine à gaz
J
  • Question
XL 2019 PB de copier de valeur dans le presse papier
Réponses
6
Affichages
1 K
JPaul78
J
I
  • Résolu(e)
XL 2019 VBA - Copier liste de mail dans presse papier
Réponses
4
Affichages
854
im_Guillaume
I
F
  • Question
Autres Copier dans presse papier ligne de Listview
Réponses
8
Affichages
1 K
FOUQUET Yves
F
R
  • Question
XL 2013 Macro de mise en presse papier des lignes - colonnes qui ont été filtrées par une sélection dans le filtre
Réponses
5
Affichages
789
Renardy
R
X
  • Question
XL 2019 Copier / Coller une ligne entre deux fichiers depuis un 3ème fichier
Réponses
0
Affichages
612
xorf
X
A
  • Question
Microsoft 365 VBA: importer dans un dossier avec un nom variable
Réponses
4
Affichages
757
A-F
A
Usine à gaz
  • Question
Microsoft 365 tester si valeur dans le presse-papier ou ClipBoard est numérique ou non
2 3
Réponses
37
Affichages
4 K
Usine à gaz
Usine à gaz

Membres actuellement en ligne

8 membres et 116 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 294
Messages
2 086 888
Membres
103 404
dernier inscrit
sultan87