Discussion :

[edlede]

Bonsoir à tous,

Je galère depuis novembre avec se sujet, pour faire simple

j'aimerai réaliser des liens hypertextes vers des fichiers situés à la racine de mon fichier Excel dans des sous dossier

Ex : Fichierxlsm
Rapport\Equipement\année\Fichier à trouver ( souvent en pdf )

Le premier problème c'est que ne veux pas fixer le chemin car tous les ans il faudrait ajouter la nouvelle cible...

je préférai scanner l’ensemble des sous dossiers pour trouver les fichiers existants. j'ai trouver ici meme me semble t il des macro allant dans ce sens, mais jusqu'à ce jour j'en ai jamais rien tiré

Toutes mes données à lier sont en colonne B et la premiere valeur commence ligne 26 sauf pour un matériel dont les onglets on un préfixe "PIP" et qui commence colonne D, mais là encore j'ai des contraintes certaine ligne de la colonne sont vides (onglet "MIC")

et le dernier problème est que le nom des Pdf est souvent plus long que le nom enregistré dans les onglet, j'aimerai comparer que la chaine de caractère issus de l'onglet pour rechercher mon fichier pdf

toutes mes cellules utilisées sont définies par des noms si ca peut aider pour la macro

je joins deux fichier pour facilité la compréhension de mes problèmes. si certain d'entre vous on des idées, je suis preneur.


Merci d'avance, je reste à votre disposition pour tous compléments d'informations.

Edlede

[kiki29]

Salut, voir Liste des fichiers d'un dossier + Liens et adapter si besoin à ton contexte.

Egalement à lire

[edlede]

Bonjour et merci kiki29,

j'ai récupéré ton fichier_Liste fichier_lien, qui ressemble effectivement beaucoup à ce je voudrai. Par contre j ai des incompatibilités de version

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
                                       Alias "FindFirstFileA" _
                                       (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" _
                                      Alias "FindNextFileA" _
                                      (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function PathMatchSpec Lib "shlwapi" _
                                       Alias "PathMatchSpecW" _
                                       (ByVal pszFileParam As Long, ByVal pszSpec As Long) As Long

le fait que le fichier soit sur un réseau d'entreprise. Y aura-t-il des pb avec le kernel 32?

vu mon niveau en vb j'aurai besoin de quelques explications sur ton code qui m'a l'air bien complet.

Merci pour la piste

j'avais déjà réalisé ceci pour la partie des sous répertoires

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
Sous répertoires du répertoire actuel
 
Sub SousRepRepActuel()
 
[a:a].Clear
 
Racine = CurDir ' Répertoire courant
 
Set fs = CreateObject("Scripting.FileSystemObject")
 
Set Dossier = fs.getfolder(Racine)
 
[A1].Select
 
For Each d In Dossier.SubFolders
 
ActiveCell = d.Name
 
ActiveCell.Offset(1, 0).Select
 
Next
 
End Sub
 
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
Function DocScan(ByVal DOC, Optional ALL As Boolean)
 
DOC = Split(CreateObject("WScript.Shell").Exec("cmd /c Dir """ & DOC & """ /B /S").StdOut.ReadAll,
 
vbCrLf)
 
If ALL Then
 
If UBound(DOC) > 0 Then ReDim Preserve DOC(UBound(DOC) - 1)
 
Else
 
If UBound(DOC) > -1 Then DOC = DOC(0) Else DOC = ""
 
End If
 
DocScan = DOC
 
End Function

Mais ca ne marche pas

[kiki29]

Salut, ta version d'Office est en 64 bits ?

[edlede]

J'avais également trouver un fichier qui me fait aussi presque tous se que j'ai besoin mais je n'est jamais réussi à le modifié pour mes besoins

je voulais déjà dans un premier temps modifier la saisie manuel du dossier par le chemin automatique de mon fichier excel.

Bien que je passe pas mal de soirée à lire les tutos et autres cours sur les sujet dont j'ai besoin, mon niveau en vb qui est franchement très faible, et le résultat est nul !!

[edlede]

Salut, ta version d'Office est en 64 bits ?

Yes chez moi, mais pas au taf je suis en train de chercher la version de ma femme pour voir si ca passe.

et j'ai lu ton message sur les recommendation d'utilisation d'office 32 plutot que 64

j'avais également pour lister l'ensemble des données de mon fichier ceci

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
' Fonction rowCount
'
'       Descr : Balaye une colonne de la feuille Excel spécifiée
'               et retourne le nombre de lignes successives pour laquelle la cellule n'est pas vide.
'
 
Public Function rowCount(ByVal oStrSheet As String, ByVal intFirstRow As Integer, ByVal intFirstCol As Integer)
 
    Dim intCpt As Integer
    Dim intCurrentRow As Integer
    Dim intNextRow As Integer
 
    intCpt = 0
 
    With Sheets(oStrSheet)
        If (.Cells(intFirstRow, intFirstCol).Value <> Null Or Len(.Cells(intFirstRow, intFirstCol).Value) > 0) Then
            intCurrentRow = intFirstRow + intCpt
            intNextRow = intCurrentRow + 1
            intCpt = 1
            Do While (.Cells(intNextRow, intFirstCol).Value <> Null Or Len(.Cells(intNextRow, intFirstCol).Value) > 0)
                intCpt = intCpt + 1
                intNextRow = intNextRow + 1
            Loop
            rowCount = intCpt
        Else
            rowCount = 0
        End If
    End With
    End Function

il me reste à définir la colonne de départ et à comparer les résultats du scan des sous dossier, puis créer un lien hypertexte lorsque la comparaison est vraie

je n'avais pas rajouter tous mes bouts de code dans le fichier exemple pour ne pas polluer le fichier.

A la vitesse ou j'avance le ne serai jamais pres pour debut juillet, date à laquelle ou je devrais former mon équipe à l'utilisation de mon fichier excel.

[edlede]

je sens que j'inspire pas grand monde avec mon sujet. mais je ne perd pas espoir, quoique

j'ai retrouvé également un petit bout de code qui devrai pouvoir me récupérer mes données pour la comparaison, mais je ne suis meme pas sur qu'il fonctionne ( va falloir que je comprenne l'insertion d'espion pour suivre mon code)

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
DefBool Y
'Cette instruction doit se trouver sur la première ligne du module
           'Avant toute autre déclaration ,Sub ou Function
 
Function testo()
 
Dim Y, Y1, Y2, Y3, Y4, Y5, Y6, i% ' % = As integer
Dim tab_entete() As Integer
Dim Nb_Feuil
Dim Nb_Champ
 
Dim Ligne_Depart
Dim Num_Col
affiche_tous
  For i = 1 To Worksheets.Count
      With Worksheets(i)
      Y1 = Left(.Name, 8) = "Synthese"
      Y2 = Left(.Name, 1) = "_"
      Y3 = Left(.Name, 6) = "Modele"
      Y4 = Left(.Name, 3) = "CAL"
      Y5 = Left(.Name, 9) = "Bienvenue"
      Y6 = Left(.Name, 3) = "PIP"
      Y = Y1 Or Y2 Or Y3 Or Y4 Or Y5
 
        If Not Y Then
        If Y <> Y6 Then
            With Worksheets(i)
          Col_rapport = 1
 
    i = 0
    i = i + 1
                        ligne_debut = Range("DTE_CARTO").Row + 1
                        ligne_fin = Range("STOP").Row - 1
                        For cpt = ligne_debut To ligne_fin
                           Rapport_lib = Cells(cpt, Col_rapport)
 
                                'Alimentation du tableau
                                cpt0 = 0
                                tab_entete(cpt0, cpt_tab) = Dte_Carto
                                cpt_tab = cpt_tab + 1
                                ReDim Preserve tab_entete(Nb_Champ, cpt_tab)
                    Next
                 End With
                 End If
                 End If
                 GoTo continue
    Y = Y6
    If Y = Y6 Then
            With Worksheets(i)
 
Col_rapport = 3
 
    i = 0
    i = i + 1
 
                        ligne_debut = Range("Etat_lib").Row + 1
                        ligne_fin = Range("STOP").Row - 1
                        For cpt = ligne_debut To ligne_fin
                           Etat_lib = Cells(cpt, Col_rapport)
 
                                'Alimentation du tableau
                                cpt0 = 0
                                tab_entete(cpt0, cpt_tab) = Etat_lib
                                cpt_tab = cpt_tab + 1
                                ReDim Preserve tab_entete(Nb_Champ, cpt_tab)
                    Next
                 End With
 
                 End If
      End With
   Next
continue: SousRepRepActuel
 
End Function
Function maj_liens()
 
'DocScan (toto)
 
End Function
 
Function SousRepRepActuel()
 
Dim tab_data(3, 10000)
 
 
Racine = ActiveWorkbook.Path                    ' Répertoire courant
Set fs = CreateObject("Scripting.FileSystemObject")
Set Dossier = fs.GetFolder(Racine)
[A1].Select
i = 0
For Each d In Dossier.subfolders
    For Each f In Dossier.Files
        tab_data(0, i) = Left(f.Name, InStr(f.Name, ".") - 1)
        tab_data(1, i) = f.Path & "\"
        tab_data(2, i) = f.Name
        i = i + 1
     Next
     Set Dossier = fs.GetFolder(Dossier.subfolders)
Next
End Function

si quelqu'un a des conseils je suis tjs prenneur