Bonjour à tous,

je souhaiterais améliorer un code que j'ai mis au point en compilant des morceaux trouvés sur internet.
Actuellement, ce code permet d'ouvrir une boîte de dialogue, de sélectionner un fichier PDF, de l'ouvrir, de copier son contenu dans un nouvel onglet et de le fermer.

Aujourd'hui, j'aimerais que ce code permette de sélectionner plusieurs fichier PDF en même temps, et de copier le contenu dans un nouvelle onglet pour chaque PDF (un PDF sélectionné = un nouvel onglet et son contenu).

Pour vous donner du contexte, tous les jours, je dois traiter une quinzaine de comptes-rendus d'analyses sanguines. Une fois que le contenu des PDF est copié dans ce fichier Excel, je mettrai en place des formules pour récupérer les données et repérer les anomalies.

Pour info :
Le fichier Excel et les PDF se situent à chaque fois dans le même dossier.
La multi-sélection est actuellement désactivée en bas de code.
Ce code désactive mon clavier numérique pour une raison que j'ignore...

Savez-vous s'il est possible de réaliser cette manip ?

Merci par avance pour votre aide, et pour vos conseils.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 
Sub test()
Dim CheminEtTypeFichier As String, Fichier As String
Dim sFichier As String
Dim sAcro As String
Dim ong As String
 
    With Sheets("Param")
        .Activate
        .Cells.Clear
    End With
 
'Variable à définir : Le chemin par défaut
CheminEtTypeFichier = "C:\Users\...\Desktop\...\Analyses sanguines"
 
Fichier = BrowseFile(CheminEtTypeFichier)
 
    If Fichier <> "" Then
        'MsgBox "Nom du fichier sélectionné : """
        sFichier = Split(Fichier, "")(UBound(Split(Fichier, "")))
        sAcro = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
 
        Shell sAcro, vbNormalFocus
 
        Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys "^o"
        Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys sFichier
        Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys "{ENTER}"
        Application.Wait (Now + TimeValue("0:00:01"))
 
        SendKeys "^a"
        Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys "^c"
        Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys "^q"
        Application.Wait (Now + TimeValue("0:00:01"))
 
        DoEvents
 
        Sheets.Add After:=Sheets(ThisWorkbook.Sheets.Count) 'créer un nouvel onglet en dernière position
        ong = (Sheets.Count) - 1
        ActiveSheet.Name = "0" & ong
 
        With ActiveSheet
            .Range("A1").Select
            .Activate
            .Paste
 
        End With
    Else
        MsgBox "Aucune sélection a été effectuée."
    End If
End Sub
 
Function BrowseFile(CheminEtTypeFichier) As String
    With Application.FileDialog(msoFileDialogFilePicker)
        'Définit un titre pour la boîte de dialogue
        .Title = "Choisir le fichier"
        'Empêcher la multi-sélection
        .AllowMultiSelect = False
        'Répertoire par défaut suivi du type de fichier par défaut
        .InitialFileName = CheminEtTypeFichier
        'Efface les filtres existants.
        .Filters.Clear
        'Indique le type d'affichage dans la boîte de dialogue
        '(exemple visualisation des propriétés)
        .InitialView = msoFileDialogViewProperties
        'Affiche la boîte de dialogue
        .Show
        If .SelectedItems.Count > 0 Then
            BrowseFile = .SelectedItems(1)
        Else
            BrowseFile = ""
        End If
    End With
End Function