Private Sub UserForm_Initialize()
Dim F As Worksheet, rep$, d As Object, nf$, a(), n&, t, i&, x$, b
Me.Height = Application.Height
Me.Width = Application.Width
Image3.Visible = False 'logo Excel
Set F = Feuil2 'CodeName de la feuille de mémorisation, à adapter
If Répertoire = "" Then Répertoire = ThisWorkbook.Path 'à adapter
rep = Répertoire & "\"
'---liste des classeurs Excel---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
nf = Dir(rep & "*.xls*")
While nf <> ""
If Not nf Like "*.pdf" And nf <> ThisWorkbook.Name Then
ReDim Preserve a(1, n) 'base 0
a(0, n) = rep & nf
a(1, n) = CDbl(FileDateTime(a(0, n))) 'nombre
d(a(0, n) & Chr(1) & a(1, n)) = ""
n = n + 1
End If
nf = Dir
Wend
'---repérage des classeurs modifiés---
t = F.[A2].CurrentRegion.Resize(, 2).Value2 'date/heure sous forme de nombre
For i = 1 To UBound(t)
x = t(i, 1) & Chr(1) & t(i, 2)
If d.exists(x) Then d.Remove x
Next
'---création des fichiers PDF---
If d.Count Then
b = d.keys
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un classeur Excel est déjà ouvert
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'si le fichier PDF est ouvert
For i = 0 To UBound(b)
x = Split(b(i), Chr(1))(0)
With Workbooks.Open(x)
.Sheets(1).ExportAsFixedFormat xlTypePDF, x & ".pdf" '1ère feuille
.Close False
End With
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
'---mémorisation des classeurs Excel---
If n Then F.[A2].Resize(n, 2) = Application.Transpose(a)
F.[A2].Offset(n).Resize(Rows.Count - n - 1, 2).Delete xlUp
F.Columns("A:B").AutoFit
'---Liste des fichiers PDF---
ChoixFichier.Clear
n = 0
nf = Dir(rep & "*.pdf")
While nf <> ""
ChoixFichier.AddItem nf
nf = Dir
n = n + 1
Wend
nbFichiers = n
End Sub