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
4 réponses
-
Bonjour Romanza, bonjour le forum,
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 -
Bonjour Romanza, bonjour le forum,
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
