Créer un lien hypertexte à partir de l'image la plus récente d'un dossier

**Max1991** · 30/06/2016, 14h56

Bonjour,

je suis nouveau sur le forum et sous VBA.

Je me suis lancé dans un projet pour une tablette professionnel Windows 7.

Le projet est composé de deux étapes majeurs.

1/ L'opérateur s'identifie dans Userform1. Si Nom et Matricule OK alors Userform2 se lance.

2/ L'opérateur fait des sélections dans 8 combobox. Une fois le formulaire remplie, il y a un bouton qui devient utilisable sur cet Userform. L'objectif du Bouton est de lancer l'APN de la tablette. (Jusque là tout fonctionne correctement).

Au moment du clique sur le bouton pour lancer l'APN, le formulaire s'exporte dans Feuil3 et s'incrémente à chaque nouvelle utilisation (Je bloque pour l'exportation mais l'APN se lance correctement (j'ai essayé avec CATIA, je n'ai pas encore la tablette) )
Mon problème c'est que je voudrais réussir l'exportation mais surtout je voudrais qu'un lien Hypertexte se crée dans Feuil3, sur la même ligne que les données des ComboBox. Voir exemple en image Ci-dessous.

Nom : Feuil3.png
Affichages : 219
Taille : 8,4 Ko

Nom : Feuil3.png
Affichages : 219
Taille : 8,4 Ko

Je souhaite dans le meilleur des mondes que le liens hypertexte se crée à partir de la dernière image en date dans le dossier source de l'APN.
Exemple :

je remplie le formulaire, je clique sur l'icone qui m'ouvre l'APN. En même temps les données des combobox s'exportent vers Feuil3. L'APN s'ouvre dans la foulée. Je fais la photo, automatiquement un lien hypertexte se crée dans Feuil3.

J'avais penser à créer le lien hypertexte à partir de l'image la plus récente en date mais je vois pas comment m'y prendre.

Voici le code du bouton de l'APN.
Pourriez-vous m'éclairer s'il vous plait ?
Je vous remercie d'avance pour votre aide.

Cordialement,

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
Private Sub CommandButton1_Click()
'Si ComboBox1 est vide
If ComboBox1 = "" Then
    'Message à l'utilisateur
    MsgBox "Choisir le Coté.", vbInformation
    'sortie de la procédure
    Exit Sub
End If
'Même chose avec ComboBox2
If ComboBox2 = "" Then
    MsgBox "Choisir le N° du Tr.", vbInformation
    Exit Sub
End If
If ComboBox3 = "" Then
    MsgBox "Choisir le N° de station.", vbInformation
    Exit Sub
End If
If ComboBox4 = "" Then
    MsgBox "Choisir la localisation.", vbInformation
    Exit Sub
End If
If ComboBox5 = "" Then
    MsgBox "Choisir le N° d'opération.", vbInformation
    Exit Sub
End If
If ComboBox6 = "" Then
    MsgBox "Choisir le type de défaut.", vbInformation
    Exit Sub
End If
If ComboBox7 = "" Then
    MsgBox "Choisir la cause du défaut.", vbInformation
    Exit Sub
End If
If ComboBox8 = "" Then
    MsgBox "Choisissez votre Nom dans la liste.", vbInformation
    Exit Sub
 
End If
' Lance l'APN lors du clique (Catia pour l'exemple)
Shell "C:\ProgramData\Catia\CatiaLaunch\CatiaLaunch.exe"
 
'lance normalement l'enregistrement des combobox dans la feuil3 mais ne fonctionne pas
    num = Sheets("Feuil3").Range("A65536").End(xlUp).Row + 1
    Sheets("Feuil3").Activate
 
    Range("B" & num).Value = ComboBox8.Value
    Range("C" & num).Value = ComboBox3.Value
    Range("D" & num).Value = ComboBox2.Value
    Range("E" & num).Value = ComboBox1.Value
    Range("F" & num).Value = ComboBox5.Value
    Range("G" & num).Value = ComboBox4.Value
    Range("H" & num).Value = ComboBox6.Value
    Range("I" & num).Value = ComboBox7.Value
 
Unload Remplir
 
End Sub

**parmi** · 30/06/2016, 21h45

Bonjour,

Est-ce que tu connais le nom du répertoire où les photos seront placées ?
En bouclant tous les fichiers du répertoire (avec Dir) et en recherchant la date la plus récente à l'aide de:

Code :

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

FileDateTime(VariableFichier)

La date la plus récente devrait, en principe, être celle de la photo prise quelques secondes auparavant...

**Max1991** · 01/07/2016, 08h08

Bonjour et merci pour cette réponse !

Je vais essayer de l'inclure ce matin.
En principe je connais le répertoire car je le choisirais lorsque j'aurais la tablette ! Normalement j'en ai une cette après midi tout équipée, avec lecteur de code barre, lecteur RFID et APN.

à l'avenir j'aimerai inclure le lecteur RFID dans la boucle pour remplir les TextsBox de mon Userform1

Sinon, avez-vous une idée concernant le problème qui fait que les données des ComboBox ne s'enregistrent pas dans la Feuil3. J'ai réussi à le faire fonctionner deux fois puis plus rien. Je ne comprends pas.
Je précise que les deux fois où ça a fonctionné, ça a écrasé la ligne au lieu d'en écrire une autre en dessous.

Cordialement,

**Max1991** · 01/07/2016, 13h55

Bonjour,

après moult tentatives cette après midi, je n'arrive pas à faire avancer le code. J'ai mis le code ci-dessous dans un module2 mais ca ne fonctionne pas.
j'ai "i = FileDateTime(Icone)" qui bug en jaune -> Erreur 53

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
Sub galopin()
Dim MyPath$, Icone$, Mem$, i
MyPath = "\\fichier-lh\users\n0563556\Documents\Mes fichiers reçus\  ' Définit le chemin d'accès.
Icone = Dir(MyPath & "*.csv")
Mem = FName
i = FileDateTime(Icone)
  Do While FName <> ""
    If FileDateTime(Icone) > i Then
    Mem = Icone
    i = FileDateTime(Icone)
    End If
  Icone = Dir
  Loop
 
MsgBox Mem
 
End Sub

**parmi** · 01/07/2016, 14h39

Icone devrait être déclarée As Variant
Dans ce que je lis, il manque une apostrophe à la fin de MyPath = ...

**Max1991** · 01/07/2016, 15h16

Bien vu mais ça ne change rien j'ai toujours cette erreur 53.

En revanche j'ai résolu le problème concernant l'exportation du formulaire. j'avais ajouté une colonne avec des numéros en colonne A. l'appli se lançait et écrivait les données du formulaire à la fin de cette liste. à la dernière ligne non vide

Tu sais comment je pourrai coder cette phrase " Fermer le document si et seulement si la dernière ligne non vide de mon tableau Feuil3 est complète" ?

**parmi** · 01/07/2016, 21h03

Pour la fermeture, ça pourrait être quelque chose comme ça, je pense

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
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim I As Long, DerLigne As Long, nbColonnes As Long
 
    With Sheets("Feuil3")
        DerLigne = .Cells(.Rows.Count, "A").End(xlUp).Row
        nbColonnes = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For I = 1 To nbColonnes
            If .Cells(DerLigne, I) = "" Then
                MsgBox "La dernière ligne n'a pas été complètement remplie"
                Cancel = True
                Exit Sub
            End If
        Next
    End With
End Sub

**parmi** · 01/07/2016, 21h07

Ici, je ne comprends pas vraiment

MyPath = "\\fichier-lh\users\n0563556\Documents\Mes fichiers reçus\ ' Définit le chemin d'accès.
Icone = Dir(MyPath & "*.csv")
Mem = FName
i = FileDateTime(Icone)

Qu'est-ce que Mem et FName ?
Si tu utilises Icone comme nom de variable, celle-ci doit être utilisée dans la boucle While

Code :

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

1
2
Do While Icone <> ""
....

**Max1991** · 04/07/2016, 09h01

Bonjour parmi,

je viens d'essayer le code ci-dessous ce matin. Au moment où je clique sur "Souhaitez-vous enregistrer et quitter" --> Oui, la dernière valeur en bas à droite de mon tableau
s'éfface. (Je l'avais complétée manuellement pour vérifier si ça fonctionné ) Du coup le programme m'affiche qu'elle n'est pas complète. Pourquoi s'éfface-t-elle selon toi ?

Merci pour tes réponses j'avance énormément.

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
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim I As Long, DerLigne As Long, nbColonnes As Long
 
    With Sheets("Feuil3")
        DerLigne = .Cells(.Rows.Count, "A").End(xlUp).Row
        nbColonnes = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For I = 1 To nbColonnes
            If .Cells(DerLigne, I) = "" Then
                MsgBox "La dernière ligne n'a pas été complètement remplie"
                Cancel = True
                Exit Sub
            End If
        Next
    End With
End Sub

**Max1991** · 04/07/2016, 09h12

Je viens de comprendre pourquoi. J'avais demandé à créer une nouvelle ligne dans le tableau avec les données de mon formulaire. Forcement lors du test la nouvelle ligne n'était pas encore totalement remplie.
Je viens de tester à partir de mon Userform voulez-vous quitter ? ça fonctionne parfaitement bien. Merci

Je vais m’atteler au problème de l'enregistrement automatique de l'image en utilisant tes infos.

**Max1991** · 04/07/2016, 09h37

Je viens de faire des modifications sur le code ci-dessous mais honnêtement je ne le comprend pas en le lisant.

Je n'arrive pas à trouver l'erreur.

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 galopin()
Dim MyPath$, Icone$, i
MyPath = "\\fichier-lh\users\n0563556\Documents\Mes fichiers reçus\  ' Définit le chemin d'accès."
Icone = Dir(MyPath & "*.csv")
 
i = FileDateTime(Icone)
  Do While Icone <> ""
    If FileDateTime(Icone) > i Then
    i = FileDateTime(Icone)
    End If
  Icone = Dir
  Loop
 
MsgBox Mem
 
End Sub

**kiki29** · 04/07/2016, 09h53

Salut, dans la FAQ il y a ceci : Lister les fichiers d'un répertoire par ordre décroissant de date de création .

**Max1991** · 04/07/2016, 10h10

Bonjour et merci kiki29 j'essaye tout de suite !

**Max1991** · 04/07/2016, 10h59

Je patauge pour l'instant.

Dois-je activer la référence "Microsoft Scripting RunTime" ?
J'ai vérifié, scrrun.dll est dans "C:\WINDOWS\SysWoW64\"
Est-ce que cela signifie que la référence "Microsoft Scripting RunTime" est activée ?

J'ai modifié Tableau par feuil3 est-ce bon selon vous ?

J'ai le droit à un message d'erreur de compilation, Type définie par l'utilisation non définie.

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
 
 
 
Option Explicit
Option Base 1
 
 
Sub triDecroissant_Fichiers_DateDreation()
    Dim Fichier As String, Chemin As String
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    '
    Dim Fso As Scripting.FileSystemObject
    Dim FileItem As Scripting.File
    Dim Feuil3()
    Dim m As Integer, i As Integer
    Dim z As Byte, Valeur As Byte
    Dim Cible As Variant
 
    '---liste les fichiers du répertoire ---
    Chemin = "\\fichier-lh\users\n0563556\Documents\Mes fichiers reçus\"
    Fichier = Dir(Chemin & "\*.*")
    'pour filtrer sur un type de fichiers (par exemple xls)
    'Fichier = Dir(Chemin & "\*.xls")
 
    'Boucle sur les fichiers
    Do
 
        m = m + 1
        ReDim Preserve Feuil3(2, m)
        Feuil3(1, m) = Fichier
 
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set FileItem = Fso.GetFile(Chemin & "\" & Fichier)
 
        'Récupère la date de création
        Feuil3(2, m) = Left(FileItem.DateCreated, 10)
        'Pour récupérer la date de dernière modification
        'Tableau(2, m) = Left(FileItem.DateLastModified, 10)
        'Pour récupérer la taille du fichier
        'Tableau(2, m) = Left(FileItem.Size, 10)
 
        Fichier = Dir
    Loop Until Fichier = ""
 
 
    '---Trie les fichiers par ordre décroissant de création ---
    Do
        Valeur = 0
        For i = 1 To m - 1
            If CDate(Feuil3(2, i)) < CDate(Feuil3(2, i + 1)) Then
                For z = 1 To 2
                    Cible = Feuil3(z, i)
                    Feuil3(z, i) = Feuil3(z, i + 1)
                    Feuil3(z, i + 1) = Cible
                Next z
 
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
 
 
    '--- Transfère les données dans la feuille de calcul ---
    For i = 1 To m
        Cells(i, 1) = Feuil3(1, i)
        Cells(i, 2) = Feuil3(2, i)
    Next i
 
    'Pour transférer par ordre croissant:
    'For i = m To 1 Step -1
        'Cells(m - i + 1, 1) = Tableau(1, i)
        'Cells(m - i + 1, 2) = Tableau(2, i)
    'Next i
 
    'Ajuste la taille des colonnes
    Columns("A:B").AutoFit
End Sub

**Max1991** · 04/07/2016, 11h14

Je viens de m’apercevoir que je n'ai pas d'accès à Outils-> "Référence" sous VBA.

**kiki29** · 04/07/2016, 11h43

Salut,

Est-ce que cela signifie que la référence "Microsoft Scripting RunTime" est activée ?

Non cela n'a rien à voir.

Bascule en Late Binding ( plus de références à cocher, comme "Microsoft Scripting RunTime" )

En modifiant les déclarations suivantes :

Code :

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

1
2
Dim Fso As Scripting.FileSystemObject
Dim FileItem As Scripting.File

en qqch comme :

Code :

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

1
2
Dim Fso As Object
Dim FileItem As Object

**Max1991** · 04/07/2016, 12h55

Comme ceci ?

Je n'ai plus de messages d'erreurs mais je n'obtiens pas le lien hypertexte qui renvoi à la dernière photo crée.
Remplacer Tableau par feuil3 est-il juste ?

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
Option Explicit
Option Base 1
 
 
Sub triDecroissant_Fichiers_DateDreation()
    Dim Fichier As String, Chemin As String
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    Dim Fso As Object
    Dim feuil3()
    Dim m As Integer, i As Integer
    Dim z As Byte, Valeur As Byte
    Dim Cible As Variant
    Dim FileItem As Object
 
 
    '---liste les fichiers du répertoire ---
    Chemin = "R:\Direction Industrielle\Operations Assemblage\11_Ligne A320 Neo\60-Stages\7006-Maxime\Projets\1) Ligne A330 Neo\12) APPLI INSPECTION V5\Images\"
    Fichier = Dir(Chemin & "\*.jpg*")
    'pour filtrer sur un type de fichiers (par exemple xls)
    'Fichier = Dir(Chemin & "\*.xls")
 
    'Boucle sur les fichiers
    Do
 
        m = m + 1
        ReDim Preserve feuil3(2, m)
        feuil3(1, m) = Fichier
 
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set FileItem = Fso.GetFile(Chemin & "\" & Fichier)
 
        'Récupère la date de création
        feuil3(2, m) = Left(FileItem.DateCreated, 10)
        'Pour récupérer la date de dernière modification
        'Tableau(2, m) = Left(FileItem.DateLastModified, 10)
        'Pour récupérer la taille du fichier
        'Tableau(2, m) = Left(FileItem.Size, 10)
 
        Fichier = Dir
    Loop Until Fichier = ""
 
 
    '---Trie les fichiers par ordre décroissant de création ---
    Do
        Valeur = 0
        For i = 1 To m - 1
            If CDate(feuil3(2, i)) < CDate(feuil3(2, i + 1)) Then
                For z = 1 To 2
                    Cible = feuil3(z, i)
                    feuil3(z, i) = feuil3(z, i + 1)
                    feuil3(z, i + 1) = Cible
                Next z
 
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
 
 
    '--- Transfère les données dans la feuille de calcul ---
    For i = 1 To m
        Cells(i, 1) = feuil3(1, i)
        Cells(i, 2) = feuil3(2, i)
    Next i
 
End Sub

**Max1991** · 04/07/2016, 13h06

En fait ça fonctionne, simplement le logiciel n'écrit pas au bon endroit

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
Option Explicit
Option Base 1
 
 
Sub triDecroissant_Fichiers_DateDreation()
    Dim Fichier As String, Chemin As String
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    Dim Fso As Object
    Dim feuil3()
    Dim m As Integer, i As Integer
    Dim z As Byte, Valeur As Byte
    Dim Cible As Variant
    Dim FileItem As Object
 
 
    '---liste les fichiers du répertoire ---
    Chemin = "\\fichier-lh\users\n0563556\Documents\Mes fichiers reçus\"
    Fichier = Dir(Chemin & "\*.jpg*")
    'pour filtrer sur un type de fichiers (par exemple xls)
    'Fichier = Dir(Chemin & "\*.xls")
 
    'Boucle sur les fichiers
    Do
 
        m = m + 1
        ReDim Preserve feuil3(2, m)
        feuil3(1, m) = Fichier
 
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set FileItem = Fso.GetFile(Chemin & "\" & Fichier)
 
        'Récupère la date de création
        feuil3(2, m) = Left(FileItem.DateCreated, 10)
        'Pour récupérer la date de dernière modification
        'Tableau(2, m) = Left(FileItem.DateLastModified, 10)
        'Pour récupérer la taille du fichier
        'Tableau(2, m) = Left(FileItem.Size, 10)
 
        Fichier = Dir
    Loop Until Fichier = ""
 
 
    '---Trie les fichiers par ordre décroissant de création ---
    Do
        Valeur = 0
        For i = 1 To m - 1
            If CDate(feuil3(2, i)) < CDate(feuil3(2, i + 1)) Then
                For z = 1 To 2
                    Cible = feuil3(z, i)
                    feuil3(z, i) = feuil3(z, i + 1)
                    feuil3(z, i + 1) = Cible
                Next z
 
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
 
 
    '--- Transfère les données dans la feuille de calcul ---
    For i = 1 To m
        Cells(i, 1) = feuil3(1, i)
        Cells(i, 2) = feuil3(2, i)
    Next i
 
End Sub

**Max1991** · 04/07/2016, 15h37

en fait j'ai tout les noms d'image du répertoire qui s'écrivent en colonne A suivi de la date de création en colonne B.

Je veux changer ces positions. je n'ai pas réussi en changeant juste les numéros qui se trouvent dans le code.

Avez-vous une piste ?

Cordialement,

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
 
Option Explicit
Option Base 1
 
 
Sub triDecroissant_Fichiers_DateDreation()
    Dim Fichier As String, Chemin As String
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    Dim Fso As Object
    Dim feuil3()
    Dim m As Integer, i As Integer
    Dim z As Byte, Valeur As Byte
    Dim Cible As Variant
    Dim FileItem As Object
 
 
    '---liste les fichiers du répertoire ---
    Chemin = "\\fichier-lh\users\n0563556\Documents\Mes fichiers reçus"
    Fichier = Dir(Chemin & "\*.jpg")
    'pour filtrer sur un type de fichiers (par exemple xls)
    'Fichier = Dir(Chemin & "\*.xls")
 
    'Boucle sur les fichiers
    Do
 
        m = m + 1
        ReDim Preserve feuil3(2, m)
        feuil3(1, m) = Fichier
 
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set FileItem = Fso.GetFile(Chemin & "\" & Fichier)
 
 
        'Récupère la date de création
        feuil3(2, m) = Left(FileItem.DateCreated, 10)
        '10 = le nombre de caractère date à afficher dans tableau
        'Pour récupérer la date de dernière modification
        'Tableau(2, m) = Left(FileItem.DateLastModified, 10)
        'Pour récupérer la taille du fichier
        'Tableau(2, m) = Left(FileItem.Size, 10)
 
        Fichier = Dir
    Loop Until Fichier = ""
 
 
    '---Trie les fichiers par ordre décroissant de création ---
    Do
        Valeur = 0
        For i = 1 To m - 1
            If CDate(feuil3(2, i)) < CDate(feuil3(2, i + 1)) Then
                For z = 1 To 2
                    Cible = feuil3(z, i)
                    feuil3(z, i) = feuil3(z, i + 1)
                    feuil3(z, i + 1) = Cible
                Next z
 
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
 
 
    '--- Transfère les données dans la feuille de calcul ---
    For i = 1 To m
        Cells(i, 1) = feuil3(1, i)
        Cells(i, 2) = feuil3(2, i)
    Next i
 
End Sub