[VBA]Récubérer chemin dossier source en "C6"

[TheLio]

[VBA]Récupérer chemin du dossier source en "C6"

Bonjour tous,
Dans le fichier joint, qui fonctionne très bien pour créer une table des matières avec liens sur tous les fichiers.
J'aimerais y apporter une modification.
Qu'il me récupère directement l'adresse du dossier où il est contenu en "C6".
Je ne peux malheureusement pas vous joindre le fichier car mon compte supporter est momentanément désactivé
mais voici le code de base:

'*****Création Table des matières*****
Private Sub CommandButton1_Click()
'adaptée de:
'http://www.developpez.net/forums/showthread.php?t=342976
'Par Moâ ;-)
'Définir le chemin du répertoire en "C6"
Dim a As Variant
a = MsgBox("Voulez vous créer la table des matières ?" & vbCrLf & "Ceci peut prendre quelques secondes" & vbCrLf & "Merci", vbYesNo + vbExclamation, "Initilisation de la recherche...")
If a = vbNo Then Exit Sub
Application.ScreenUpdating = False
Selection.AutoFilter Field:=1
Range("B6").Value = "*"
Rows("9:65536").Select
Selection.ClearContents
Selection.FormatConditions.Delete
Range("B6").Select
Dim chemin As String
Dim i As Integer
Dim objFSO As Object, objFile As Object
chemin = Range("C6") 'C'est ICI que l'on choisi le chemin
Set objFSO = CreateObject("Scripting.FileSystemObject")
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.LookIn = chemin
.SearchSubFolders = True
.Execute
Cells(8, 1).Value = "N°"
Cells(8, 2).Value = "Nom Dossier"
Cells(8, 3).Value = "Nom fichier"
Range("A88").Font.Bold = True
With .FoundFiles
For i = 1 To .Count
Cells(i + 8, 1) = i
Worksheets(1).Hyperlinks.Add Cells(i + 8, 3), .Item(i)
Cells(i + 8, 3).Hyperlinks(1).TextToDisplay = Dir(.Item(i))

Set objFile = objFSO.GetFile(.Item(i))
Cells(i + 8, 2) = Dir(objFSO.GetParentFolderName(objFile), vbDirectory)

Next i
End With
End With

Columns("C").AutoFit
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=SI($A14>0;MOD(LIGNE();2)=0)"
Selection.FormatConditions(1).Font.ColorIndex = 1
With Selection.FormatConditions(1).Interior
.PatternColorIndex = 15
.Pattern = xlGray25
End With
Selection.Font.Bold = True
Range("B6").Select
Application.ScreenUpdating = True
MsgBox "Génération de table" & vbCrLf & "terminée." & vbCrLf & "Merci" & vbCrLf & "LJA", _
vbInformation, "Fin de recherche"
End Sub

Actuellement, le chemin est choisi ainsi:

'*****Ouverture de la boîte de dialogue chemin*****
Private Sub CommandButton3_Click()
Dim objShell, objFolder, chemin, SecuriteSlash
Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Sélection du dossier à analyser", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:"
End If
If objFolder.Title = "" Then
chemin = ""
End If
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
Range("C6").Value = chemin
End Sub

Merci pour vos pistes
A++
Lio

 

[ChTi160]

Re : [VBA]Récubérer chemin dossier source en "C6"

Salut
bonjour le fil
Bonjour le Forum

arff je ne comprends pas tout lol
que veux tu dire par

Qu'il me récupère directement l'adresse du dossier où il est contenu en "C6".

tu veux que la macro te récupère le chemin ou aller chercher dans la cellule C6
mais ce Chemin est il le même que le Chemin ou se trouve ton fichier d'où tu lances la macro ??? Lol

car si ton Chemin est le même que le Chemin de ton fichier d'ou tu lances la macro un ThisWorkBook.Path suffirait
car Chemin =This WorkBook.Path renvoie le chemin du Fichier Actif ,arff pas sur d'avoir compris pas du tout
tu as aussi cette fonction qui te renvoie le chemin du classeur actif (enregistré)

=GAUCHE(CELLULE("filename");CHERCHE("[";CELLULE("filename");1)-2)

sinon donne un exemple de ce que tu entends par

Qu'il me récupère directement l'adresse du dossier où il est contenu en "C6".

dans l'attente
Merci d'avance
Bonne Journée

 

[TheLio]

Re : [VBA]Récubérer chemin dossier source en "C6"

Bonjour Chti,
Bien remis de ton année en plus ???
Effectivement mes explications n'étaient pas très claires.
Mais j'ai trouvé une soluce:
Dans un module:

Public VPath as String

Et dans Workbook_Open

Range("C6").Value = ThisWorkbook.Path

Merci tout de même pour l'attention apportée
A++ Lio

 

[JCGL]

Re : [VBA]Récubérer chemin dossier source en "C6"

Bonjour à tous,
Salut JM Tchou-Tchou
Salut The Lio

Pour le fun et pour connaître le Chemin complet et ses variantes par formules

A++
A+ à tous