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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
| Option Explicit
Private Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean
Dim Debut As Currency, Fin As Currency, Freq As Currency
Dim iCpt As Long
Private Sub CommandButton1_Click()
Dim sFichier As String, WsShell As Object
sFichier = Me.TextBox1
If Len(sFichier) = 0 Then Exit Sub
Set WsShell = CreateObject("WScript.Shell")
WsShell.Run "AcroRd32 " & sFichier
Set WsShell = Nothing
End Sub
Private Sub CommandButton2_Click()
Dim sChemin As String
Dim sStr As String
sChemin = ThisWorkbook.Path & "\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = sChemin
.Title = "Sélectionner le Dossier Racine"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewDetails
.ButtonName = "Sélection Dossier"
.Show
If .SelectedItems.Count > 0 Then
iCpt = 0
TextBox2 = ""
DoEvents
QueryPerformanceCounter Debut
With Me
.WebBrowser1.Navigate "http://about.blank"
.TextBox1 = ""
.ListBox1.Clear
.ListBox1.ColumnCount = 2
.ListBox1.ColumnWidths = "400;0"
End With
Liste .SelectedItems(1), Me.chkRecur.Value
If chkTri Then Tri_Listbox
QueryPerformanceCounter Fin
QueryPerformanceFrequency Freq
sStr = Format((Fin - Debut) / Freq, "0.00 s")
TextBox2 = TextBox2 & " / " & sStr
End If
End With
End Sub
Private Sub ListBox1_Click()
Me.TextBox1 = ListBox1.Column(1) & "\" & ListBox1.List(ListBox1.ListIndex)
End Sub
Private Sub Liste(sChemin As String, bSousDossier As Boolean)
Dim FSO As Object, Dossier As Object, Fichier As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(sChemin)
Fichier = Dir$(sChemin & "\*.*")
Do While Len(Fichier) > 0
If UCase$(FSO.GetExtensionName(Fichier)) Like ("PDF") Then
With Me.ListBox1
.AddItem Fichier
.List(iCpt, 0) = Fichier
.List(iCpt, 1) = sChemin
iCpt = iCpt + 1
TextBox2 = iCpt
DoEvents
End With
End If
Fichier = Dir$()
Loop
If bSousDossier Then
For Each Dossier In Dossier.SubFolders
Liste Dossier.Path, True
Next Dossier
End If
Set FSO = Nothing
End Sub
Private Sub Textbox1_Change()
WebBrowser1.Navigate TextBox1.Text & "#zoom=100%&page=1&toolbar=1"
End Sub
Private Sub Tri_Listbox()
Dim i As Long
Dim j As Long
Dim sTemp As String
Dim sTemp2 As String
Dim LbList As Variant
LbList = Me.ListBox1.List
For i = LBound(LbList, 1) To UBound(LbList, 1) - 1
For j = i + 1 To UBound(LbList, 1)
If UCase$(LbList(i, 0)) > UCase$(LbList(j, 0)) Then
sTemp = LbList(i, 0)
LbList(i, 0) = LbList(j, 0)
LbList(j, 0) = sTemp
sTemp2 = LbList(i, 1)
LbList(i, 1) = LbList(j, 1)
LbList(j, 1) = sTemp2
End If
Next j
Next i
With Me
.ListBox1.Clear
.ListBox1.List = LbList
End With
End Sub
Private Sub UserForm_Initialize()
With UserForm1
.Width = 640
.Height = 480
End With
With ListBox1
.Left = 5
.Top = 5
.Width = UserForm1.Width / 3 - 10
.Height = UserForm1.Height - 73
.IntegralHeight = False
End With
With WebBrowser1
.Left = ListBox1.Left + ListBox1.Width + 5
.Top = 5
.Width = 2 * UserForm1.Width / 3 - 8
.Height = UserForm1.Height - 73
End With
With CommandButton2
.Left = 5
.Top = UserForm1.Height - 60
.Width = 90
.Height = 30
End With
With CommandButton1
.Left = 2 * UserForm1.Width / 3
.Top = UserForm1.Height - 60
.Width = 90
.Height = 30
End With
With chkRecur
.Left = CommandButton2.Left + CommandButton2.Width + 5
.Top = UserForm1.Height - 60
.Width = 65
.Height = 30
End With
With chkTri
.Left = chkRecur.Left + chkRecur.Width + 5
.Top = chkRecur.Top
.Width = 45
.Height = 30
End With
With TextBox2
.Left = chkTri.Left + chkTri.Width + 5
.Top = UserForm1.Height - 55
.Width = 40
.Height = 18
.BackStyle = fmBackStyleTransparent
End With
End Sub |
Ajout d'une image à un PDF
Envoyé par kiki29
Partager