Discussion :

[Cédric59300]

Bonjour

J'ai actuellement un fichier excel pour la gestion du planning d'audit.
Mon objectif est que chaque auditeur puisse dans la colonne "Rapport" importer directement leur fichier (que se soit sous format .doc / .docx / .pdf) et que se fichier s'enregistre directement dans le bon répertoire.

Pour cela les auditeurs utiliserai le bouton "Import" et une msgBox s'afficherai pour qu'ils puissent choisir leur fichier.
Et une fois le fichier enregistré dans le bon répertoire, la date d'import du fichier s'inscrit automatique dans la cellule "validé" correspondant.

Est-ce que cela est réalisable avec une macro ?

Merci par avance de votre aide
Cédrci

PS : je joins un exemple de type de fichier utilisé.

[Theze]

Bonjour,

Une piste.
Voir les commentaires dans le code :

planning_audit_V2.xlsm

[Cédric59300]

Bonjour,

Une piste.
Voir les commentaires dans le code :

planning_audit_V2.xlsm

Bonjour Theze

Merci ta macro est super.
Je l'ai un peu modifier suite au dernière demande faite et maintenant cela donne :

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
Sub Importer()
 
Dim S As Shape
Dim Dossier As String
Dim Fichier() As String
Dim I As Integer
 
'récup du chemin du dossier
Dossier = "\\192.168.220.206\fad\QHSE\"
 
'affiche un message pour informer qu'il va falloir choisir les fichiers
MsgBox "Choix des fichiers à copier !"
 
'récup des fichiers
Fichier() = Explorateur(3)
 
'si annulé, fin !
If Fichier(1) = "" Then MsgBox "Action annulée !": Exit Sub
 
'copie les fichiers dans le dossier
For I = 1 To UBound(Fichier)
 
FileCopy Fichier(I), Dossier & Dir(Fichier(I))
 
Next I
 
'inscrit la date dans la cellule correspondante
Set S = Worksheets("Feuil1").Shapes(Application.Caller)
S.TopLeftCell.Offset(, 1).Value = Date
 
End Sub
 
 
Function Explorateur(I As Integer) As String()
 
Dim Tbl() As String
Dim Fich
Dim J As Integer
 
With Application.FileDialog(I)
 
If I = 4 Then
 
ReDim Tbl(1 To 1)
If .Show = -1 Then Tbl(1) = .SelectedItems(1) Else Tbl(1) = ""
 
Else
 
If .Show = -1 Then
 
For Each Fich In .SelectedItems
 
J = J + 1: ReDim Preserve Tbl(1 To J)
Tbl(J) = Fich
 
Next Fich
 
Else
 
ReDim Tbl(1 To 1): Tbl(1) = ""
 
End If
 
End If
 
End With
 
Explorateur = Tbl
 
End Function

Cependant j'ai un message d'erreur au moment d'inscrire la date.
Je n'arrive pas à trouver où se situe l'erreur.
Pourras-tu m'aider.

[Theze]

Bonjour,

J'ai modifié un peu le code par rapport à ton dernier message.
En ce qui concerne la date, elle est inscrite sur la cellule située à droite (colonne E de ton fichier exemple) de la cellule où est posé le bouton cliqué. Si je prend par exemple le premier bouton situé lui en D4, la date sera inscrite en E4 et pour savoir quelle cellule doit être prise en compte, j'utilise la propriété "Caller" de l'objet "Application" donc, le bouton doit être lié à la macro "Importer" (clic droit sur le bouton puis "Affecter une macro...") afin de pouvoir récupérer l'objet "range" (cellule) sur laquelle il est posé et de là, la cellule d'à coté pour y inscrire la date. Si tu n'appliques pas cette façon de procéder, tu risques d'avoir des résultats qui ne correspondront pas à tes attentes :

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
 
Sub Importer()
 
    Dim S As Shape
    Dim Dossier As String
    Dim Fichier() As String
    Dim I As Integer
 
    'récup du chemin du dossier
    Dossier = "\\192.168.220.206\fad\QHSE\"
 
    'affiche un message pour informer qu'il va falloir choisir les fichiers
    MsgBox "Choix des fichiers à copier !"
 
    'récup des fichiers
    Fichier() = Explorateur
 
    'si annulé, fin !
    If Fichier(1) = "" Then MsgBox "Action annulée !": Exit Sub
 
    'copie les fichiers dans le dossier
    For I = 1 To UBound(Fichier)
 
        FileCopy Fichier(I), Dossier & Dir(Fichier(I))
 
    Next I
 
    'inscrit la date dans la cellule correspondante
    Set S = Worksheets("Feuil1").Shapes(Application.Caller)
    S.TopLeftCell.Offset(, 1).Value = Date
 
End Sub
 
 
Function Explorateur() As String()
 
    Dim Tbl() As String
    Dim Fich
    Dim J As Integer
 
    With Application.FileDialog(3)
 
        If .Show = -1 Then
 
            For Each Fich In .SelectedItems
 
            J = J + 1: ReDim Preserve Tbl(1 To J)
            Tbl(J) = Fich
 
            Next Fich
 
        Else
 
            ReDim Tbl(1 To 1): Tbl(1) = ""
 
        End If
 
    End With
 
    Explorateur = Tbl
 
End Function

[Cédric59300]

Parfait cela marche très bien, je vais étudier la macro en profondeur pour la comprendre.
Surtout que j'ai encore quelques macro à faire, et je débute malheureusement...

[Theze]

Bonjour,

Content de t'avoir aidé

et je débute malheureusement...

nous l'avons tous fait sans exception

[Menhir]

Mon objectif est que chaque auditeur puisse dans la colonne "Rapport" importer directement leur fichier (que se soit sous format .doc / .docx / .pdf) et que se fichier s'enregistre directement dans le bon répertoire.

Pour cela les auditeurs utiliserai le bouton "Import" et une msgBox s'afficherai pour qu'ils puissent choisir leur fichier.
Et une fois le fichier enregistré dans le bon répertoire, la date d'import du fichier s'inscrit automatique dans la cellule "validé" correspondant.

Quand tu parles d'importer un fichier dans une colonne, je suppose que tu parles de son nom, n'est-ce pas ?

Une MsgBox ne permet pas de sélectionner un fichier. Elle permet juste d'afficher et message et de proposer des boutons standard.
Tu peux permettre à l'utilisateur de choisir le fichier avec la méthode GetOpenFileName
https://msdn.microsoft.com/library/8...ice.15%29.aspx

Tu peux ensuite le copier où tu souhaites avec l'instruction FileCopy.
https://msdn.microsoft.com/fr-fr/VBA...copy-statement

Il ne te reste plus ensuite qu'à mettre la date ( fonction Now() ) dans la cellule souhaitée.