VBA et chemin des adresses de dossiers

[manulemalin13000]

Bonjour,

Jai une question concernant un code VBA
J'ai un chemin du type: C:\Documents and Settings\m178655\Desktop\manu
qui me sert à aller chercher des infos pour executer une macro
Le probleme est que quand je change d'ordinateur l'adresse n'etant pas la meme ca plante

Comment faire pour que ca marche partout ?

Merci

 

[Robert]

Re : VBA et chemin des adresses de dossiers

Bonjour Manulemalin, bonjour le forum,

Difficile de te répondre... si par hasard le chemin est le même que là où se trouve ton fichier tu pourrais utiliser un code du style :

Dim chem As String
chem = ThisWorkbook.Path

 

[pedrag31]

Re : VBA et chemin des adresses de dossiers

Bonjour Manulemalin, Bonjour Robert, bonjour le forum,

Le mieux aurait été que tu nous propose un fichier en pièce jointe pour que l'on puisse mieux comprendre ton problème...

Toutefois, je te propose d'essayer d'intégrer le code suivant en début de ta macro pour aller chercher ton chemin sur le PC ou tu te trouves et éviter le plantage :

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "Veuillez selectionner le repertoire dans lequel recuperer les informations"
    .Show

    If .SelectedItems.Count = 1 Then
    [COLOR="Red"]Chemin = .SelectedItems(1)[/COLOR]
    ElseIf .SelectedItems.Count = 0 Then
    MsgBox "Pas de dossier selectionne." & vbCr & vbCr & "Merci de relancer le programme.", vbExclamation
    Exit Sub
    End If
End With

A tester...

Et en amont de la macro, pour avoir ton chemin disponible dans toutes tes macros, tu peux également déclarer le chemin en public :

Public Chemin As String

En espérant que ça réponde a ta question...😉

Bonne journée, 🙂

 

[manulemalin13000]

Re : VBA et chemin des adresses de dossiers

Bonjour et merci pour vos réponses,

Voici mon code...
Il comporte plusieurs macros associées
C'est juste les chemins qui sont problématiques auqnd je change d'ordinateur
Merci de votre aide



Sub ListeFichiers_rech()
'Manu
' Debut Code pour nettoyer la feuille et repartir sur du vierge
Sheets("Feuil1").Select
Rows("2:14").Select
Selection.ClearContents
Sheets("Feuil2").Select
Range("A2:A60").Select
Selection.ClearContents
' Fin Code pour nettoyer la feuille et repartir sur du vierge
'Application qui va chercher les infos
'Selection.ClearContents
Sheets("Feuil1").Select
Range("A1").Select
Dim Dossier As Object, Fichier As Object
Dim Chemin As String
Dim i As Long
'Chemin du dossier à analyser (à adapter au besoin)
'Chemin = ThisWorkbook.Path
Chemin = ActiveSheet.Range("A1").Value 'Sheets("paramètrage").Range("b5").Value
'Chemin = "c:\"
'Définition de la variable
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
' Boucle sur les fichiers
Range("a2").Select
i = 2
'Stop
For Each Fichier In Dossier.Files

'Cells(I, 1) = Fichier.Name ' Nom du fichier
'Cells(I, 2) = Fichier.DateCreated ' Date dernière modification
Cells(i, 1).Formula = Fichier.Path
Cells(i, 2).Formula = Fichier.Name
Cells(i, 3).Formula = Fichier.Size
Cells(i, 4).Formula = Fichier.Type
Cells(i, 5).Formula = Fichier.DateCreated
Cells(i, 6).Formula = Fichier.DateLastAccessed
Cells(i, 7).Formula = Fichier.DateLastModified
'Cells(I, 8).Formula = Fichier.ParentFolder
i = i + 1
Next
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Cells.Replace What:="C:\Documents and Settings\m160446\Desktop\Bioanalyzer\" _
, Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
Sheets("Feuil1").Select
Range("A3:A14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Kill "C:\Documents and Settings\m160446\Desktop\Bioanalyzer\\*ladder*"
Application.Run "Renommer"
End Sub
Sub Renommer()
On Error Resume Next
Dim i As Integer

i = 1
While Cells(i, 1) <> 0
i = i + 1
Cells(i, 1).Select
Name "C:\Documents and Settings\m160446\Desktop\Bioanalyzer\" & Range("A" & i) As "C:\Documents and Settings\m160446\Desktop\Bioanalyzer\" & "\" & Range("B" & i)
Wend
Range("A1").Select
Application.Run "importimage"

End Sub

Sub ImportImage()
Sheets("QC_file").Select
Dim oShell, oFolder, oFolderItem
Dim Rep As String, Img As String, Tablo
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.BrowseForFolder(0, "Dossier images", 0)
If Not (oFolder) Is Nothing Then
Set oFolderItem = oFolder.Items.Item
Rep = oFolderItem.Path
Img = Dir(Rep & "\" & "*.jpeg")
j = ActiveCell.Column
i = ActiveCell.Row
Do While Img <> ""
Tablo = Split(Img, "*.*")
With ActiveSheet
.Cells(i, j - 1) = Tablo(0)
Set c = .Cells(i, j)
.Shapes.AddPicture Rep & "\" & Img, True, True, _
c.Left, c.Top, c.Width, c.Height
End With
Img = Dir()
i = i + 1
Loop

End If
ActiveSheet.DrawingObjects.Select
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
Set oFolderItem = Nothing
Set oFolder = Nothing
Set oShell = Nothing
Kill "C:\Documents and Settings\m160446\Desktop\Bioanalyzer\\*sample*"
End Sub