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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
| #If VBA7 Then
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
#Else
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
#End If
Private Const GHND = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096
Sub test()
Dim txt As String
txt = "EN COMMANDE - 3 X 57679 - MODULE FOUR WHIRLPOOL 480131000045 - 481221458442 - PUISSANCE" & vbCrLf
txt = txt & "EN COMMANDE - 25 X 65532 - SONDE FRIGO WHIRLPOOL 481221058078" & vbCrLf
txt = txt & "EN COMMANDE - 4 X 25641 - MODULE FOUR WHIRLPOOL 480131000053" & vbCrLf
txt = txt & "EN COMMANDE - 4 X 22228 - GRILLE MICRO-ONDE WHIRLPOOL 481246678434" & vbCrLf
txt = txt & "EN COMMANDE - 2 X 57679 - MODULE FOUR WHIRLPOOL 480131000045 - 481221458442 - PUISSANCE" & vbCrLf
txt = txt & "EN COMMANDE - 2 X 23089 - KIT SECHAGE GENTEL DRYING 481281719157" & vbCrLf
txt = txt & "EN COMMANDE - 1 X 20316 - THERMOSTAT FRIGO WHIRLPOOL 481927128774" & vbCrLf
txt = txt & "EN COMMANDE - 2 X 57679 - MODULE FOUR WHIRLPOOL 480131000045 - 481221458442 - PUISSANCE" & vbCrLf
txt = txt & "EN COMMANDE - 2 X 18661 - AQUASTOP UNIVERSEL - BEKO LV 1885090100" & vbCrLf
txt = txt & "***** EN COMMANDE - 2 X 92984 - THERMOSTAT FRIGO LIEBHERR* 6151186 - 615118600 - A130417R - K59H2622 - K59L2677"
ClipBoard_SetData Replace(Replace(Replace(txt, "-", vbTab), " ", vbTab), "*", "")
ActiveSheet.Cells.NumberFormat = "@"
ActiveSheet.Cells(1,"A").PasteSpecial xlPasteAll
If Trim("" & ActiveSheet.Cells(Cells.Rows.Count, "B").End(xlUp).Offset(0, -1)) = "" Then ActiveSheet.Cells(Cells.Rows.Count, "B").End(xlUp).Offset(0, -1).Delete Shift:=xlToLeft
End Sub
Function ClipBoard_GetData() As String
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim MyString As String
Dim RetVal As Long
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"
GoTo OutOfHere
End If
' 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.
MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If
OutOfHere:
RetVal = CloseClipboard()
ClipBoard_GetData = MyString
End Function
Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long
' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)
' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If
' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
' Clear the Clipboard.
X = EmptyClipboard()
' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function |
Extraction de chaine de caractères
Répondre avec citation
Partager