Chemin relatif dans cette MACRO
romanza
Messages postés
249
Date d'inscription
Statut
Membre
Dernière intervention
-
ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention -
ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention -
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
- Jitbit macro recorder - Télécharger - Confidentialité
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- 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
- Vba ouvrir un fichier excel avec chemin ✓ - Forum VB / VBA
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