Chemin relatif dans cette MACRO
romanza
Messages postés
263
Statut
Membre
-
ThauTheme Messages postés 1564 Statut Membre -
ThauTheme Messages postés 1564 Statut Membre -
Bonjour,
Je souhaite pouvoir en activant ma macro définir un chemin relatif allant chercher le sous dossier "Retours formulaires" dans le dossier "AMIE" (voir en gras)qu'un utilisateur lambda aura positionné dans un répertoire choisi.
Pouvez-vous me modifier ma macro dans ce sens.
je vous remercie.
Romanza
Sub import_Bdretours()
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("Bd")
chemin = "c:\AMIE\Retours formulaires\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = Array("NOM", "PRENOM", "NuméroSS", "PasdeNumSS", "Datnaiss", "Paysnaiss", "Comnaiss", "Dept", "Nat", "Sexe", "Adresse", "CP", "Commune", "Télmob", "Télfixe", "mail", "Bourse", "Bachelier", "SécuFranceOUI", "ADAssuré", "NomAssuré", "DatenaisAssuré", "LienAssuré", "Autresit", "AutrEtab", "EuroSuisse", "Québec", "Plusde28", "CentPay", "Formation", "AnnéeEtude", "Visascol")
nb_Champs = 32
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = Variables(i)
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "clients.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(Variables(i)).result
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
Columns("V:V").Activate
Selection.TextToColumns Destination:=Range("V1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
'
'
Range("A1:Af1065").Activate
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Activate
Call Macro2
End Sub
Je souhaite pouvoir en activant ma macro définir un chemin relatif allant chercher le sous dossier "Retours formulaires" dans le dossier "AMIE" (voir en gras)qu'un utilisateur lambda aura positionné dans un répertoire choisi.
Pouvez-vous me modifier ma macro dans ce sens.
je vous remercie.
Romanza
Sub import_Bdretours()
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("Bd")
chemin = "c:\AMIE\Retours formulaires\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = Array("NOM", "PRENOM", "NuméroSS", "PasdeNumSS", "Datnaiss", "Paysnaiss", "Comnaiss", "Dept", "Nat", "Sexe", "Adresse", "CP", "Commune", "Télmob", "Télfixe", "mail", "Bourse", "Bachelier", "SécuFranceOUI", "ADAssuré", "NomAssuré", "DatenaisAssuré", "LienAssuré", "Autresit", "AutrEtab", "EuroSuisse", "Québec", "Plusde28", "CentPay", "Formation", "AnnéeEtude", "Visascol")
nb_Champs = 32
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = Variables(i)
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "clients.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(Variables(i)).result
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
Columns("V:V").Activate
Selection.TextToColumns Destination:=Range("V1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
'
'
Range("A1:Af1065").Activate
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Activate
Call Macro2
End Sub
A voir également:
- Chemin relatif dans cette MACRO
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Chaque fichier en ligne sur le web a un chemin d’accès sur un serveur. c’est le cas du fichier du logo présent sur la page de cette ville. quel est le chemin de ce fichier à partir de la racine du site ? ✓ - Forum Windows
- Excel récupérer couleur cellule sans macro ✓ - Forum Bureautique
4 réponses
Bonjour Romanza, bonjour le forum,
pas sûr d'avoir bien compris... Essaie comme ça :
Tu utilises ensuite la variable CHEMIN.
À plus,
ThauTheme
pas sûr d'avoir bien compris... Essaie comme ça :
Sub Macro1()
Dim D As FileDialog
Dim CHEMIN As String
Set D = Application.FileDialog(msoFileDialogFolderPicker)
D.InitialFileName = "c:\AMIE\Retours formulaires\"
If D.Show = -1 Then
CHEMIN = D.SelectedItems(1)
MsgBox CHEMIN 'à supprimer
End If
End Sub
Tu utilises ensuite la variable CHEMIN.
À plus,
ThauTheme
Bonjour Thau Theme,
je ne suis pas calé en macro. Comment j'insère ton code dans la macro initiale. En d'autres termes peux-tu me retourner la macro plug an play.
cette macro va chercher des formulaires word dans un répertoire (qui pourra donc être choisi par l'utilisateur) et va coller les infos du formulaire dans un tableau excel.
merci à toi
je ne suis pas calé en macro. Comment j'insère ton code dans la macro initiale. En d'autres termes peux-tu me retourner la macro plug an play.
cette macro va chercher des formulaires word dans un répertoire (qui pourra donc être choisi par l'utilisateur) et va coller les infos du formulaire dans un tableau excel.
merci à toi
Bonjour Romanza, bonjour le forum,
Essaie comme ça :
Essaie comme ça :
Sub import_Bdretours()
Dim D As FileDialog
Dim CHEMIN As String
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("Bd")
Set D = Application.FileDialog(msoFileDialogFolderPicker)
D.InitialFileName = "c:\AMIE\Retours formulaires\"
If D.Show = -1 Then
CHEMIN = D.SelectedItems(1)
MsgBox CHEMIN 'à supprimer
End If
mesfichiers = Dir(CHEMIN & "*.doc")
Dim Variables As Variant
Variables = Array("NOM", "PRENOM", "NuméroSS", "PasdeNumSS", "Datnaiss", "Paysnaiss", "Comnaiss", "Dept", "Nat", "Sexe", "Adresse", "CP", "Commune", "Télmob", "Télfixe", "mail", "Bourse", "Bachelier", "SécuFranceOUI", "ADAssuré", "NomAssuré", "DatenaisAssuré", "LienAssuré", "Autresit", "AutrEtab", "EuroSuisse", "Québec", "Plusde28", "CentPay", "Formation", "AnnéeEtude", "Visascol")
nb_Champs = 32
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = Variables(i)
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "clients.doc" Then
monDocument = CHEMIN & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(Variables(i)).result
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
Columns("V:V").Activate
Selection.TextToColumns Destination:=Range("V1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
'
'
Range("A1:Af1065").Activate
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Activate
Call Macro2
End Sub
