ListView et copie des lignes

Le 17/08/20 à 11:18, Brat'ac a écrit :

Bonjour,

Avec le code suivant je sélectionne toutes les lignes d'une listview
-------------------------------------------------------------------
For i = 1 To ListView1.ListItems.count
       ListView1.ListItems(i).Selected = True
       ListView1.SetFocus
   Next i
-------------------------------------------------------------------

Comment faire pour qu'elles soient copiées dans le presse-papier en même
temps

Merci

Bonjour,

Je ne sais pas pourquoi, tu veux copier ces données dans le
presse-papier, mais il est possible de mettre ces données dans une
variable "Tableau - Array" et de travailler par la suite avec ce tableau.

Mon exemple place les données d'un "listview" dans un tableau et les
copie dans une plage de cellules.

Au besoin, tu peux utiliser la commande "Conversion" pour répartir les
données dans leur colonne respective.

'--------------------------------------
Private Sub CommandButton3_Click()
Dim T(), i As Long, A As Long
For i = 1 To ListView1.ListItems.Count
ReDim Preserve T(1 To i)
A = ListView1.ListItems(i).ListSubItems.Count
For x = 1 To A
T(i) = T(i) & ListView1.ListItems(i).SubItems(x) & " - "
Next
T(i) = Left(T(i), Len(T(i)) - 3)
ListView1.SetFocus
Next i
'Copie le tableau dans une plage de cellules débutant en A1 de la
feuille active.
Range("A1").Resize(UBound(T)) = Application.Transpose(T)
End Sub
'--------------------------------------

MichD

Il se trouve que MichD a formulé :

Le 17/08/20 à 11:18, Brat'ac a écrit :

Bonjour,

Avec le code suivant je sélectionne toutes les lignes d'une listview
-------------------------------------------------------------------
For i = 1 To ListView1.ListItems.count
       ListView1.ListItems(i).Selected = True
       ListView1.SetFocus
   Next i
-------------------------------------------------------------------

Comment faire pour qu'elles soient copiées dans le presse-papier en même
temps

Merci

Bonjour,

Je ne sais pas pourquoi, tu veux copier ces données dans le presse-papier,
mais il est possible de mettre ces données dans une variable "Tableau -
Array" et de travailler par la suite avec ce tableau.

Mon exemple place les données d'un "listview" dans un tableau et les copie
dans une plage de cellules.

Au besoin, tu peux utiliser la commande "Conversion" pour répartir les
données dans leur colonne respective.

'--------------------------------------
Private Sub CommandButton3_Click()
Dim T(), i As Long, A As Long
For i = 1 To ListView1.ListItems.Count
ReDim Preserve T(1 To i)
A = ListView1.ListItems(i).ListSubItems.Count
For x = 1 To A
T(i) = T(i) & ListView1.ListItems(i).SubItems(x) & " - "
Next
T(i) = Left(T(i), Len(T(i)) - 3)
ListView1.SetFocus
Next i
'Copie le tableau dans une plage de cellules débutant en A1 de la feuille
active.
Range("A1").Resize(UBound(T)) = Application.Transpose(T)
End Sub
'--------------------------------------

MichD

J'ai une erreur "Argument ou appel de procédure incorrect" ici
T(i) = Left(T(i), Len(T(i)) - 3)

MichD avait énoncé :

Le 17/08/20 à 11:18, Brat'ac a écrit :

Bonjour,

Avec le code suivant je sélectionne toutes les lignes d'une listview
-------------------------------------------------------------------
For i = 1 To ListView1.ListItems.count
       ListView1.ListItems(i).Selected = True
       ListView1.SetFocus
   Next i
-------------------------------------------------------------------

Comment faire pour qu'elles soient copiées dans le presse-papier en même
temps

Merci

Bonjour,

Je ne sais pas pourquoi, tu veux copier ces données dans le presse-papier,
mais il est possible de mettre ces données dans une variable "Tableau -
Array" et de travailler par la suite avec ce tableau.

Mon exemple place les données d'un "listview" dans un tableau et les copie
dans une plage de cellules.

Au besoin, tu peux utiliser la commande "Conversion" pour répartir les
données dans leur colonne respective.

'--------------------------------------
Private Sub CommandButton3_Click()
Dim T(), i As Long, A As Long
For i = 1 To ListView1.ListItems.Count
ReDim Preserve T(1 To i)
A = ListView1.ListItems(i).ListSubItems.Count
For x = 1 To A
T(i) = T(i) & ListView1.ListItems(i).SubItems(x) & " - "
Next
T(i) = Left(T(i), Len(T(i)) - 3)
ListView1.SetFocus
Next i
'Copie le tableau dans une plage de cellules débutant en A1 de la feuille
active.
Range("A1").Resize(UBound(T)) = Application.Transpose(T)
End Sub
'--------------------------------------

MichD

J'ai une erreur
"Argument ou appel de procédure incorect"
ici T(i) = Left(T(i), Len(T(i)) - 3)

Le 17/08/20 à 13:41, Brat'ac a écrit :

T(i) = Left(T(i), Len(T(i)) - 3)

Entre chaque items j'insère le symbole "-" avec cette ligne de code :
T(i) = T(i) & ListView1.ListItems(i).SubItems(x) & " - "

Cette ligne de code ne fait qu'enlever le dernier " - " suivant le
dernier élément.

Modifie comme ceci au cas ou t(i) est vide

If Len(t(1)) > 0 then
T(i) = Left(T(i), Len(T(i)) - 3)
End if

MichD

MichD a exposé le 17/08/2020 :

Le 17/08/20 à 13:41, Brat'ac a écrit :

T(i) = Left(T(i), Len(T(i)) - 3)

Entre chaque items j'insère le symbole "-" avec cette ligne de code :
T(i) = T(i) & ListView1.ListItems(i).SubItems(x) & " - "

Cette ligne de code ne fait qu'enlever le dernier " - " suivant le dernier
élément.

Modifie comme ceci au cas ou t(i) est vide

If Len(t(1)) > 0 then
T(i) = Left(T(i), Len(T(i)) - 3)
End if

MichD

OK Merci

Bonjour,

Le 17/08/2020 à 17:18, Brat'ac a écrit :

Bonjour,

Avec le code suivant je sélectionne toutes les lignes d'une listview
-------------------------------------------------------------------
For i = 1 To ListView1.ListItems.count
       ListView1.ListItems(i).Selected = True
       ListView1.SetFocus
   Next i
-------------------------------------------------------------------

Comment faire pour qu'elles soient copiées dans le presse-papier en même temps

Merci

Au boulot pour mes automates j'utilise le code ci-dessous à adapter à ton cas :

' Module1
Option Explicit

Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function CloseClipboard Lib "user32.dll" () As Long
Declare Function EmptyClipboard Lib "user32.dll" () As Long
Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Declare Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32.dll" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
' Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal
lpString2 As Long) As Long

Public Const GHND = &H42
Public Const CF_TEXT = 1 ' Const CF_UNICODETEXT As Long = &HD
Public Const MAXSIZE = 4096

Function GetClipboard() As String
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim MyString As String
Dim RetVal As Long

MyString = ""
If OpenClipboard(0&) = 0 Then
MsgBox "Cannot open Clipboard. Another app. may have it open"
Exit Function
End If
' Obtain the handle to the global memory
' block that is referencing the text.
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "Could not allocate memory"
Else
' Lock Clipboard memory so we can reference
' the actual data string.
lpClipMemory = GlobalLock(hClipMemory)

If Not IsNull(lpClipMemory) Then
MyString = Space$(MAXSIZE)
RetVal = lstrcpy(MyString, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)
' Peel off the null terminating character.
If InStr(1, MyString, Chr$(0), 0) > 0 Then
MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
End If
Else
MsgBox "Could not lock memory to copy string from."
End If
End If
RetVal = CloseClipboard()
GetClipboard = MyString
End Function

Function SetClipboard(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long

If Len(MyString) = 0 Then
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
X = EmptyClipboard()
If CloseClipboard() = 0 Then MsgBox "Could not close Clipboard."
Else
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1) ' Allocate moveable global memory
lpGlobalMemory = GlobalLock(hGlobalMemory) ' Lock mem. to get a far pointer to this memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString) ' Copy the string to this global memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then ' Unlock the memory.
MsgBox "Could not unlock memory location. Copy aborted."
Else
If OpenClipboard(0&) = 0 Then ' Open the Clipboard to copy data to.
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
X = EmptyClipboard() ' Clear the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory) ' Copy the data to the Clipboard.
If CloseClipboard() = 0 Then MsgBox "Could not close Clipboard."
End If
End If
End Function

Michel__D avait énoncé :

Au boulot pour mes automates j'utilise le code ci-dessous à adapter à ton cas
:

Bonjour,

Merci du retour.

Entre temps j'avais trouvé ici des exemples.

https://stackoverflow.com/questions/14219455/excel-vba-code-to-copy-a-specific-string-to-clipboard

Bonne journée

Le 19/08/2020, Michel__D a supposé :

Bonjour,

Bon finalement j'ai réussi à m'en sortir comme cela.

Sub CopyText(Text As String)
'VBA Macro using late binding to copy text to clipboard.
'By Justin Kay, 8/15/2014
Dim MSForms_DataObject As Object
Set MSForms_DataObject =
CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub

Private Sub CommandButton1_Click()
Dim Ligne As String
Dim CrLf As String
Dim LigneAll As String

CrLf = Chr(13) & Chr(10)

For i = 1 To ListView1.ListItems.count
ListView1.ListItems(i).Selected = True
ListView1.SetFocus
Ligne = ListView1.SelectedItem.Text
LigneAll = LigneAll & CrLf + Ligne
Next i
SetClipboard (LigneAll)
End Sub