inventaires produits chimiquesdepuis pdf "Fiches de Données Sécurité"

**IronHeavy** · 20/06/2019, 09h42

Bonjour à tous!

Dans l'optique de créer un outil complet de gestion du risque chimique, je me trouve confronté à une réalité bien connue des services HSE: la gestion des Fiche de Données Sécurité - pdf comportant 16 rubriques "normalisées" fournies par les fabricants de produits chimiques. Il en existe des centianes de milliers, plusieurs centaines sont nécessaires aux activités de mon entreprise.

J'espère pouvoir extraire les informations pertinentes des FDS utiles dans le but de créer un inventaire exploitable (plusieurs applications en découleraient: suivi des expositions individuelle des salariés - calcul des seuils réglementaire de stockage - édition d'étiquettes - édition de certificats - ...) - PS je fonctionne sans Acrobat Pro !

Ci dessous une Fiche de Donnée Sécurité type (white spirit comme exemple)

fds white spirit.pdf

Les données que je cherche à extraire sont :

RUBRIQUE  1 : Nom du produit
              code du produit
              raison sociale fournisseur
RUBRIQUE 2 : pictogrammes de danger (codes type GHS09 - pas les images)
             mentions de danger
RUBRIQUE 3 : n° EC 
             n° REACH                   (dans le tableau identification)
             % (concentration)
RUBRIQUE 9 : Etat physique
             Point d'éclair °C
             Point d'ébullition °C
             Pression de vapeur kPa
             pH
RUBRIQUE 14 : Numero ONU

...

Une première piste de développement me permettrait de me mettre le pied à l'étrier...
Merci!

**BENNASR** · 20/06/2019, 09h47

bonjour
tu peux consulter l'intervention de Kiki29 (bonjour au passage) en ce sujet :

https://www.developpez.net/forums/d4...e/#post5920178

**IronHeavy** · 20/06/2019, 13h14

Bonjour,

Il me semble que les solutions proposées par Kiki29 utilisent Acrobat Pro, ce qui n'est pas mon cas!

**IronHeavy** · 24/06/2019, 16h10

J'ai finalement recouru à une solution détournée - coller le contenu du pdf sur word et le traiter ensuite par excel... Il y a sûrement plus court , mais cela me permet de faire quelques pas de plus!

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
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
Option Explicit
 
' ----------------------------------------------------------------
' Extraction des données à partir de fichier Word vers Excel
' Par : Grand Chaman Excel -- 2013/03/05
'-----------------------------------------------------------------
Sub Importation_Donnees_Word()
 
    ' -- Déclaration des variables
    Dim wb As Workbook          'classeur Excel dans lequel on importe les données
    Dim ws As Worksheet         'onglet Excel dans lequel on importe les données
    Dim sChemin As String       'répertoire contenant les fichiers Word
    Dim sNomFichier As String   'nom du fichier Word
    Dim WApp As Object, WDoc As Object, WSel As Object
    Dim i As Integer
 
    ' -- Initialisation des variables
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
    sChemin = ChoisirRepertoire & "\"          'fonction pour choisir le répertoire contenant les fichier Word
    'sChemin = ThisWorkbook.Path & "\"           'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
    sNomFichier = Dir(sChemin & "*.doc*")       'pour ouvrir tous les fichiers .doc*. 1er fichier.
 
    Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
    WApp.Visible = True                        'ne pas afficher Word pendant l'exécution
    i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1   '1re ligne où on va écrire les données dans le fichier Excel
 
    Application.ScreenUpdating = False
 
    ' -- Boucle sur les fichiers
    Do While Len(sNomFichier) > 0
 
        Set WDoc = WApp.Documents.Open(sChemin & sNomFichier)   'ouvre le document Word
        Application.StatusBar = "Écriture ligne " & i       'message dans Excel pour voir la progression
 
        ' Nom du fichier
        ws.Cells(i, 1) = sNomFichier
 
        ' Nom du produit (par la fonction FIND)
        WApp.Selection.HomeKey unit:=6              'Retourne au début du fichier Word
        WApp.Selection.Find.ClearFormatting         'on "vide la mémoire" de la fonction Recherche
        WApp.Selection.Find.Execute "Nom du produit"    'On trouve le texte "Nom du produit"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(i, 2) = Trim(Split(WSel, ":")(1))      'Le Nom du produit est la 2e chaîne de caractères séparés par 2 ":"
 
        ' Nom du fournisseur (par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "Raison sociale"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        ws.Cells(i, 3) = Split(WSel, ":")(1)
 
         ' Mentions de danger (par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "Mentions de danger et informations additionnelles sur les dangers :"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        ws.Cells(i, 4) = Split(WSel, ":")(1)
 
        ' Numéro CE(par la fonction FIND)
       ' WApp.Selection.HomeKey unit:=6
       ' WApp.Selection.Find.ClearFormatting
       ' WApp.Selection.Find.Execute "EC :"
       ' WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
       ' Set WSel = WApp.Selection
       ' ws.Cells(i, 5) = Split(WSel, ":")(1)
 
         ' Numéro REACH(par la fonction FIND)
       ' WApp.Selection.HomeKey unit:=6
       ' WApp.Selection.Find.ClearFormatting
       ' WApp.Selection.Find.Execute "REACH :"
       ' WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
       ' Set WSel = WApp.Selection
       ' ws.Cells(i, 6) = Split(WSel, ":")(1)
 
           ' concentration (par la fonction FIND)
       ' WApp.Selection.HomeKey unit:=6
       ' WApp.Selection.Find.ClearFormatting
       ' WApp.Selection.Find.Execute "REACH :"
       ' WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
       ' Set WSel = WApp.Selection
       ' ws.Cells(i, 7) = Split(WSel, ":")(1)
 
          ' Etat physique(par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "Etat physique :"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        ws.Cells(i, 8) = Split(WSel, ":")(1)
 
           ' PH(par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "pH :"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        ws.Cells(i, 9) = Split(WSel, ":")(1)
 
           ' Point d'éclair(par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "Point d'éclair :"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        ws.Cells(i, 10) = Split(WSel, ":")(1)
 
         ' Point d'ébullition(par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "Point/intervalle d'ébullition :"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        ws.Cells(i, 11) = Split(WSel, ":")(1)
 
        ' Pression de vapeur (par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "Pression de vapeur (50°C):"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        ws.Cells(i, 12) = Split(WSel, ":")(1)
 
        ' Numéro ONU (par la fonction FIND)
       ' WApp.Selection.HomeKey unit:=6
       ' WApp.Selection.Find.ClearFormatting
       ' WApp.Selection.Find.Execute "Numéro ONU"
       ' WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
       ' Set WSel = WApp.Selection
       ' ws.Cells(i, 13) = Split(WSel, ":")(1)
 
 
        i = i + 1                       'prochaine ligne
        WDoc.Close False                'fermer le document Word sans enregistrer
        sNomFichier = Dir               'prochain document
    Loop
 
SortieNormale:
    Application.ScreenUpdating = True
    WApp.Quit                           'Fermer l'instance de Word
    Application.StatusBar = False       'Remise à zéro de la barre d'état
 
End Sub
 
Function ChoisirRepertoire() As String
' -- Fonction permettant de choisir un répertoire
    Dim oRepertoire As Object
    ChoisirRepertoire = ""
    Set oRepertoire = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)
    If (Not oRepertoire Is Nothing) Then ChoisirRepertoire = oRepertoire.Items.Item.Path
    Set oRepertoire = Nothing
End Function

A ce stade, je rencontre 3 soucis!

- les fiches de données ne sont pas forcément rédigées de la même manière. Par exemple, "Raison sociale" peut être remplacé par "Fournisseur" "Producteur",... Comment puis je incrémenter un choix dans mon code me permettant de parcourir les différentes formules existantes, sélectionner la bonne, extraire les données et poursuivre sans erreur...?

- les valeurs texte sont transposées sans soucis, pas les valeurs numériques... déclaration de variable à ajouter/modifier pour que les 2 soient reconnues?

- le fait de n'utiliser qu'une "borne" est plus léger pour le codage, mais ne me permet pas de récupérer tous les arguments dans chaque rubrique...

Par exemple, apère mention de danger, je pourrais n'avoir qu'une mention"h220" ,mais parfois j'en ai plusieurs: "H221 - H222 - H223"... et cela change à chaque Fiche! il faudrait que je puisse "encadrer" ces données avec une seconde borne de recherche... mais je ne sais pas encore le faire...

Merci pour vos conseils!

**patricktoulon** · 24/06/2019, 20h35

salut Ironman heu..non!! heavy

ci joint un fichier

tu lance test
tu attend(pas longtemps(quelques secondes))
et tu regarde le sheets

pour comprendre

agrandir et regarder le UserForm
analyse le code (UserForm et module)

un petit apercu

Nom : demo2.gif
Affichages : 877
Taille : 1,17 Mo

**IronHeavy** · 25/06/2019, 10h13

Bonjour Patrick Toulon

,

Merci pour ton renfort!

J'ai adapté le chemin vers le pdf, la macro tourne mais bloque à la ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
For i = 1 To UBound(arr)
        rubrique = rubrique & vbCrLf & vbCrLf & "Rubrique" & arr(i) & Split(Split(texte, "RUBRIQUE " & arr(i))(1), "RUBRIQUE ")(0)

"Erreur d'exécution '9': l'indice n'appartient pas à la sélection"

Une suggestion?

**patricktoulon** · 25/06/2019, 10h22

re
ben non je vois pas, si on fait le test avec le même fichier il n'y a pas de raison

**patricktoulon** · 25/06/2019, 10h25

on peut éventuellement mettre une condition d'existence de la rubrique mais si elle y est et que tu le choppe pas je peux pas te dire

perso j'ai testé avec le fichier que tu a donné

**IronHeavy** · 25/06/2019, 10h29

Pas de prérequis soft ? (Adobe pro, microsoft Query, références VBA,... ?)

J'ai fait sauter la protection du pdf, pas mieux...

**patricktoulon** · 25/06/2019, 10h57

remplace la sub par celle ci et dis moi les quelles rubriques manquent a l'appel

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
Sub test()
    fichier = "C:\Users\polux\DeskTop\fds white spirit.pdf"
    texte = GetPDFtexte(fichier, True)
    arr = Array(, 1, 2, 3, 9, 14)
    For i = 1 To UBound(arr)
        If texte Like "*RUBRIQUE " & arr(i) & "*" Then
            rubrique = rubrique & vbCrLf & vbCrLf & "Rubrique" & arr(i) & Split(Split(texte, "RUBRIQUE " & arr(i))(1), "RUBRIQUE ")(0)
        End If
    Next
    CreateObject("htmlfile").parentwindow.clipboardData.clearData
    CreateObject("htmlfile").parentwindow.clipboardData.setData "TEXT", rubrique
    With ActiveSheet
        .Cells(1).Select
        .Paste
    End With
End Sub

la seul chose que tu a besoins c'est d'avoir un adobe reader installé sur ta machine
pour que le web browser puisse afficher le pdf
le adobe Reader gratuit suffit je suppose que tu en a un déjà non? sinon je vois pas comment tu pourrais lire tes pdfs

**IronHeavy** · 25/06/2019, 11h26

oui, j'ai bien Adobe reader DC d'installé!

"erreur d'exécution 80070057 : argument non valide"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

CreateObject("htmlfile").parentwindow.clipboardData.setData "TEXT", rubrique

Chrome est sensé s'ouvrir? ou Edge?

**Arkham46** · 25/06/2019, 13h08

Bonjour,

Si votre version de word (et celle des utilisateurs) sait ouvrir les pdf, alors continuez dans cette voie.

PS : j'ai retiré la pièce jointe qui me semble contenir des informations confidentielles.

**patricktoulon** · 25/06/2019, 14h54

Envoyé par IronHeavy

oui, j'ai bien Adobe reader DC d'installé!

"erreur d'exécution 80070057 : argument non valide"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

CreateObject("htmlfile").parentwindow.clipboardData.setData "TEXT", rubrique

Chrome est sensé s'ouvrir? ou Edge?

ni l'un ni l'autre
c'est juste pour me donner accès au clipboard windows qui me sert a stocker avant de paster

**IronHeavy** · 25/06/2019, 16h38

Envoyé par Arkham46

Bonjour,

Si votre version de word (et celle des utilisateurs) sait ouvrir les pdf, alors continuez dans cette voie.

PS : j'ai retiré la pièce jointe qui me semble contenir des informations confidentielles.

Hum... pour le moment j'effectue manuellement une conversion PDF to word ou excel sur navigateur! Je n'ai pas automatisé cette partie, d'où l'intérêt de la solution de PatrickToulon !

si elle voulait bien s'exécuter chez moi...

Le pdf en PJ est disponible gratuitement sur internet.

**Arkham46** · 25/06/2019, 17h35

ok j'ai réactivé la pièce jointe.

pour word, je pensais que c'était une ouverture directe (les versions les plus récentes de word lisent le pdf)

**patricktoulon** · 25/06/2019, 21h22

re
Bonsoir
en effet je viens de tester sur 2013 et 2016 et on a bien un soucis de latence sur l'accès au clipboard
quand je relance apres avoir cliquer sur debaugage ca matcth

c'est étonnant car on est justement dans un do/loop d'attente du clipboard
il faut que je la gère autrement
je vais regarder

**patricktoulon** · 25/06/2019, 21h25

re
dans le UserForm faute de mieux change la sub évènement status
en attendant que je trouve le moyen de le plomber ce clipboard

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
Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
'MsgBox "coucou"
 
    T = ""
    With CreateObject("WScript.Shell")    'creation wsshell dynamique late binding
        .SendKeys "^a", True    'selectionne tout
        .SendKeys "^c", True    'copy
    End With
re:
    Do
        DoEvents
       On Error GoTo re
       With CreateObject("htmlfile"): T = .parentwindow.clipboardData.GetData("Text"): End With
    Loop Until T <> ""
    Me.Hide
End Sub

**IronHeavy** · 26/06/2019, 09h35

AH ça bouge !

... "mais" !

- si cette page web est ouverte, la fonction intégre toute la conversation dans ma feuil1

- si chrome est fermé, retour à l'erreur précédente:

"erreur d'exécution 80070057 : argument non valide"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

CreateObject("htmlfile").parentwindow.clipboardData.setData "TEXT", rubrique

on se rapproche...

**patricktoulon** · 26/06/2019, 09h49

re
bonjour iron

si la page est ouverte, si lchrome est ouvert ,etc....
mais c'est quoi ca ??
qui t'a parler d'ouvrir la page web?
qui t'a parler d'ouvrir chrome?

tout se passe dans le webbrowser qui est caché dans le userform
alors fait moi plaisir ferme toute tes app et laisse ouvert que ce satané fichier excel

Nom : demo2.gif
Affichages : 596
Taille : 1,44 Mo

Nom : demo2.gif
Affichages : 596
Taille : 1,44 Mo

**patricktoulon** · 26/06/2019, 10h13

re
bon pour que tu/je comprenne ce qui se passe chez toi on va utiliser une visionneuse perso

tu va ouvrir ce fichier cliquer sur le bouton vert, choisir ton fichier pdf
ensuite quand tu vois le pdf dans le webbrowser en dessous du bouton tu va utiliser les touche flèche gauche et droite et pas d'autre !!!!!!
et dis moi si tes pages changent a chaque touche tapées
c'est pas compliqué

inventaires produits chimiquesdepuis pdf "Fiches de Données Sécurité"

Macros et VBA Excel

Discussions similaires

Partager

Partager