[Déplacé VB6 --> VBA] PATH RELATIF VBA WORD
Résolu
julienbouchot
Messages postés
7
Date d'inscription
jeudi 16 juillet 2009
Statut
Membre
Dernière intervention
24 juillet 2009
-
20 juil. 2009 à 09:41
julienbouchot Messages postés 7 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 24 juillet 2009 - 24 juil. 2009 à 05:20
julienbouchot Messages postés 7 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 24 juillet 2009 - 24 juil. 2009 à 05:20
3 réponses
julienbouchot
Messages postés
7
Date d'inscription
jeudi 16 juillet 2009
Statut
Membre
Dernière intervention
24 juillet 2009
24 juil. 2009 à 05:20
24 juil. 2009 à 05:20
Je viens de trouver la solution pour ceux que ca intéresse :
ThisDocument.path
Ca fonctionne maintenant merci
Julien
ThisDocument.path
Ca fonctionne maintenant merci
Julien
cs_Jack
Messages postés
14006
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
79
20 juil. 2009 à 10:41
20 juil. 2009 à 10:41
Salut
App.Path, c'est du VB6
En VBA :
Application.Path Chemin de l'applicatif Word
ActiveDocument.Path Chemin du document courant
Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés
Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
App.Path, c'est du VB6
En VBA :
Application.Path Chemin de l'applicatif Word
ActiveDocument.Path Chemin du document courant
Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés
Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
julienbouchot
Messages postés
7
Date d'inscription
jeudi 16 juillet 2009
Statut
Membre
Dernière intervention
24 juillet 2009
24 juil. 2009 à 05:14
24 juil. 2009 à 05:14
Bonjour,
activedocument.path ne fonctionne pas non plus...
Je copie colle mon code :
en effet la variable est toujours vide.
Rem MACRO DE PRISE DE REFERENCE CHRONO
Rem Par Philippe BRUNET (POMA-OTIS), 24/05/2000
Rem version visual basic 2000
Rem Version anglaise adaptée POMA BEIJING par Jean-Pierre DURAND (POMA), 07/03/2009
Public Sub MAIN()
Dim titre_dlg$
Dim chrono$
Dim datechrono$
Dim type_chro$
Dim bouton As Integer
Dim emet$
Dim dest$
Dim soc$
Dim noaff$
Dim class$
Dim nomapp$
Dim objet$
Dim fich_type$
Dim fich_nom$
Dim full_path$
Dim cur_path$
Dim annee$
Dim Dlgmistake As Object
Dim h As String
Rem on error Goto mistakes
titre_dlg$ = "V3.0 Chrono ref POMA BEIJING ROPEWAY"
Rem-----------------------DEFINITION DE LA BOITE DE DIALOGUE-------------------------------
WordBasic.BeginDialog 378, 238, titre_dlg$
WordBasic.Text 8, 20, 68, 13, "Sender": WordBasic.TextBox 148, 15, 200, 18, "emet$"
WordBasic.Text 8, 40, 92, 13, "Receiver": WordBasic.TextBox 148, 35, 200, 18, "dest$"
WordBasic.Text 8, 60, 59, 13, "Company": WordBasic.TextBox 148, 55, 200, 18, "soc$"
WordBasic.Text 8, 80, 120, 13, "Project number": WordBasic.TextBox 148, 75, 50, 18, "noaff$": WordBasic.Text 205, 77, 92, 13, "(3 digits)"
WordBasic.Text 8, 100, 117, 13, "Sorting": WordBasic.TextBox 148, 95, 200, 18, "class$"
WordBasic.Text 8, 120, 120, 13, "Project name": WordBasic.TextBox 148, 115, 200, 18, "nomapp$"
WordBasic.Text 8, 140, 50, 13, "Subject": WordBasic.TextBox 148, 135, 200, 18, "Objet$"
WordBasic.CancelButton 130, 200, 110, 25
WordBasic.PushButton 130, 172, 110, 25, "&No chrono"
WordBasic.PushButton 15, 172, 110, 25, "&Fax chrono"
WordBasic.PushButton 245, 172, 110, 25, "&Letter chrono"
Rem PushButton 245, 172, 110, 25, "Chrono &CR"
WordBasic.EndDialog
Rem-----------------------MAJ et AFFICHAGE DE LA BOITE DE DIALOGUE-------------------------------
Dim Dlgsaisie As Object: Set Dlgsaisie = WordBasic.CurValues.UserDialog
Dlgsaisie.emet$ = WordBasic.[GetBookmark$]("emet")
Dlgsaisie.dest$ = WordBasic.[GetBookmark$]("dest")
Dlgsaisie.soc$ = WordBasic.[GetBookmark$]("soc")
Dlgsaisie.noaff$ = WordBasic.[GetBookmark$]("noaff")
Dlgsaisie.class$ = WordBasic.[GetBookmark$]("class")
Dlgsaisie.nomapp$ = WordBasic.[GetBookmark$]("nomapp")
Dlgsaisie.objet$ = WordBasic.[GetBookmark$]("objet")
chrono$ = WordBasic.[GetBookmark$]("chrono")
datechrono$ = WordBasic.[GetBookmark$]("datechrono")
type_chro$ WordBasic.[GetBookmark$]("type_chro"): If type_chro$ "" Then type_chro$ = "R"
Rem ------------------ RECUPERE LES INFOS DE LA BOITE DE DIALOGUE ------------------------
bouton = WordBasic.Dialog.UserDialog(Dlgsaisie)
emet$ = Dlgsaisie.emet$
dest$ = Dlgsaisie.dest$
soc$ = Dlgsaisie.soc$
noaff$ = Dlgsaisie.noaff$
class$ = Dlgsaisie.class$
nomapp$ = Dlgsaisie.nomapp$
objet$ = Dlgsaisie.objet$
Rem------------PRISE DE LA REFERENCE CHRONO----------------------------------------
'bouton = 0 <=> annuler
'bouton = 1 <=> sans chrono
'bouton = 2 <=> avec chrono (le fax ou le courrier si un seul bouton, ou le fax si 2 choix possibles)
'bouton = 3 <=> avec chrono (le courrier si choix possible entre fax et courrier, sinon, inexistant)
If bouton = 0 Then GoTo fin
If bouton 2 Then type_chro$ "F"
If bouton 3 Then type_chro$ "C"
Rem ----definition de la date
ReDim nommois$(12)
nommois$(1) "Jan": nommois$(2) "Feb": nommois$(3) = "Mar"
nommois$(4) "Apr": nommois$(5) "May": nommois$(6) = "Jun"
nommois$(7) "Jul": nommois$(8) "Aug": nommois$(9) = "Sep"
nommois$(10) "Oct": nommois$(11) "Nov": nommois$(12) = "Dec"
datechrono$ = Str(Day(Now())) + " " + nommois$(Month(Now())) + Str(year(Now()))
Rem ----ENREGISTREMENT DU CHRONO DANS UN FICHIER EXCEL----
'Demande confirmation
''Ouverture d'une instance d'excel, avec vérification s'il est déjà ouvert.
cur_path$ = ActiveDocument.Path
annee$ = year(Date)
Dim xlAppList As Excel.Application
Dim xls As Excel.Workbook
Dim ExcelFile
ExcelFile = "U:\Macro FAX\REPORTING\report_bei.xls"
On Error Resume Next
Set xlAppList = GetObject(ExcelFile, "Excel.Application")
If xlAppList Is Nothing Then
Set xlAppList = CreateObject("Excel.Application")
End If
On Error GoTo 0
xlAppList.Visible = True
Set xls = xlAppList.Workbooks.Open(ExcelFile)
Rem Ecriture dans la dernière ligne du tableau.
dercell = Range("A1").End(xlDown).Row + 1
chrono$ = xlAppList.Cells(dercell - 1, 1).Value + 1
xlAppList.Cells(dercell, 1) = chrono$ 'Calcul du chrono
xlAppList.Cells(dercell, 2) = emet$
xlAppList.Cells(dercell, 3) = dest$
xlAppList.Cells(dercell, 4) = soc$
xlAppList.Cells(dercell, 5) = noaff$
xlAppList.Cells(dercell, 6) = class$
xlAppList.Cells(dercell, 7) = nomapp$
xlAppList.Cells(dercell, 8) = objet$
xlAppList.Cells(dercell, 9) = datechrono$
xlAppList.Range(Cells(dercell, 1), Cells(dercell, 9)).Borders(xlEdgeLeft).Weight = xlMedium
xlAppList.Range(Cells(dercell, 1), Cells(dercell, 9)).Borders(xlEdgeRight).Weight = xlMedium
xlAppList.Range(Cells(dercell, 1), Cells(dercell, 9)).Borders(xlEdgeBottom).Weight = xlMedium
xlAppList.Range(Cells(dercell, 1), Cells(dercell, 9)).Borders(xlInsideVertical).Weight = xlMedium
xlAppList.Cells(dercell + 1, 1).Select
'Sauvegarde et fermeture de l'application
ActiveWorkbook.Save
ActiveWorkbook.Close False
xlAppList.Quit
chrono$ = NumPrefix(CInt(chrono$), 3)
Rem Choix de la feuille à ouvrir en fonction du type de doc. choisi
If type_chro$ = "F" Then
fich_nom$ = "FS_" + annee$ + "_" + chrono$ + "_" + objet$ + ".doc"
full_path$ = cur_path$ + "\FAXS\FAXS_SENT" + fich_nom$
End If
If type_chro$ = "C" Then
Sheets("Courrier").Select
End If
If type_chro$ = "N" Then
Sheets("Notes et CR").Select
End If
'Sauvegarde du document dans le dossier de stockage.
ActiveDocument.SaveAs full_path$
MsgBox ("Votre document est sauvegardé sous le nom : " + fich_nom$)
Rem ----FIN----
Rem #####
Rem-----------DEFINITION DES CHAMPS DE RENVOI DANS LE DOC---------------
majchamps:
Selection.HomeKey Unit:=wdStory
ActiveWindow.View.ShowFieldCodes = True
ActiveDocument.Paragraphs(1).Range.Select
Selection.Delete
Selection.Fields.Add Range:=Selection.Range, Text:="set emet " + Chr(34) + emet$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set dest " + Chr(34) + dest$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set noaff " + Chr(34) + noaff$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set soc " + Chr(34) + soc$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set class " + Chr(34) + class$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set nomapp " + Chr(34) + nomapp$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set objet " + Chr(34) + objet$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set datechrono " + Chr(34) + datechrono$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set chrono " + Chr(34) + chrono$ + Chr(34) + Chr(32), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set type_chro " + Chr(34) + type_chro$ + Chr(34) + Chr(32), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set fich_type " + Chr(34) + fich_type$ + Chr(34), PreserveFormatting:=False
ActiveWindow.View.ShowFieldCodes = False
Rem--------------------REMPLISSAGE FICHE RESUME------------------------------------
With Dialogs(wdDialogFileSummaryInfo)
.Title = objet$
.Subject = noaff$ + " / " + class$ + " / " + nomapp$ + " / " + objet$
.Author = emet$
.Keywords = dest$ + " (" + soc$ + ")"
.Execute
End With
GoTo fin
fin:
ActiveDocument.PrintPreview
ActiveDocument.ClosePrintPreview
End Sub
activedocument.path ne fonctionne pas non plus...
Je copie colle mon code :
en effet la variable est toujours vide.
Rem MACRO DE PRISE DE REFERENCE CHRONO
Rem Par Philippe BRUNET (POMA-OTIS), 24/05/2000
Rem version visual basic 2000
Rem Version anglaise adaptée POMA BEIJING par Jean-Pierre DURAND (POMA), 07/03/2009
Public Sub MAIN()
Dim titre_dlg$
Dim chrono$
Dim datechrono$
Dim type_chro$
Dim bouton As Integer
Dim emet$
Dim dest$
Dim soc$
Dim noaff$
Dim class$
Dim nomapp$
Dim objet$
Dim fich_type$
Dim fich_nom$
Dim full_path$
Dim cur_path$
Dim annee$
Dim Dlgmistake As Object
Dim h As String
Rem on error Goto mistakes
titre_dlg$ = "V3.0 Chrono ref POMA BEIJING ROPEWAY"
Rem-----------------------DEFINITION DE LA BOITE DE DIALOGUE-------------------------------
WordBasic.BeginDialog 378, 238, titre_dlg$
WordBasic.Text 8, 20, 68, 13, "Sender": WordBasic.TextBox 148, 15, 200, 18, "emet$"
WordBasic.Text 8, 40, 92, 13, "Receiver": WordBasic.TextBox 148, 35, 200, 18, "dest$"
WordBasic.Text 8, 60, 59, 13, "Company": WordBasic.TextBox 148, 55, 200, 18, "soc$"
WordBasic.Text 8, 80, 120, 13, "Project number": WordBasic.TextBox 148, 75, 50, 18, "noaff$": WordBasic.Text 205, 77, 92, 13, "(3 digits)"
WordBasic.Text 8, 100, 117, 13, "Sorting": WordBasic.TextBox 148, 95, 200, 18, "class$"
WordBasic.Text 8, 120, 120, 13, "Project name": WordBasic.TextBox 148, 115, 200, 18, "nomapp$"
WordBasic.Text 8, 140, 50, 13, "Subject": WordBasic.TextBox 148, 135, 200, 18, "Objet$"
WordBasic.CancelButton 130, 200, 110, 25
WordBasic.PushButton 130, 172, 110, 25, "&No chrono"
WordBasic.PushButton 15, 172, 110, 25, "&Fax chrono"
WordBasic.PushButton 245, 172, 110, 25, "&Letter chrono"
Rem PushButton 245, 172, 110, 25, "Chrono &CR"
WordBasic.EndDialog
Rem-----------------------MAJ et AFFICHAGE DE LA BOITE DE DIALOGUE-------------------------------
Dim Dlgsaisie As Object: Set Dlgsaisie = WordBasic.CurValues.UserDialog
Dlgsaisie.emet$ = WordBasic.[GetBookmark$]("emet")
Dlgsaisie.dest$ = WordBasic.[GetBookmark$]("dest")
Dlgsaisie.soc$ = WordBasic.[GetBookmark$]("soc")
Dlgsaisie.noaff$ = WordBasic.[GetBookmark$]("noaff")
Dlgsaisie.class$ = WordBasic.[GetBookmark$]("class")
Dlgsaisie.nomapp$ = WordBasic.[GetBookmark$]("nomapp")
Dlgsaisie.objet$ = WordBasic.[GetBookmark$]("objet")
chrono$ = WordBasic.[GetBookmark$]("chrono")
datechrono$ = WordBasic.[GetBookmark$]("datechrono")
type_chro$ WordBasic.[GetBookmark$]("type_chro"): If type_chro$ "" Then type_chro$ = "R"
Rem ------------------ RECUPERE LES INFOS DE LA BOITE DE DIALOGUE ------------------------
bouton = WordBasic.Dialog.UserDialog(Dlgsaisie)
emet$ = Dlgsaisie.emet$
dest$ = Dlgsaisie.dest$
soc$ = Dlgsaisie.soc$
noaff$ = Dlgsaisie.noaff$
class$ = Dlgsaisie.class$
nomapp$ = Dlgsaisie.nomapp$
objet$ = Dlgsaisie.objet$
Rem------------PRISE DE LA REFERENCE CHRONO----------------------------------------
'bouton = 0 <=> annuler
'bouton = 1 <=> sans chrono
'bouton = 2 <=> avec chrono (le fax ou le courrier si un seul bouton, ou le fax si 2 choix possibles)
'bouton = 3 <=> avec chrono (le courrier si choix possible entre fax et courrier, sinon, inexistant)
If bouton = 0 Then GoTo fin
If bouton 2 Then type_chro$ "F"
If bouton 3 Then type_chro$ "C"
Rem ----definition de la date
ReDim nommois$(12)
nommois$(1) "Jan": nommois$(2) "Feb": nommois$(3) = "Mar"
nommois$(4) "Apr": nommois$(5) "May": nommois$(6) = "Jun"
nommois$(7) "Jul": nommois$(8) "Aug": nommois$(9) = "Sep"
nommois$(10) "Oct": nommois$(11) "Nov": nommois$(12) = "Dec"
datechrono$ = Str(Day(Now())) + " " + nommois$(Month(Now())) + Str(year(Now()))
Rem ----ENREGISTREMENT DU CHRONO DANS UN FICHIER EXCEL----
'Demande confirmation
''Ouverture d'une instance d'excel, avec vérification s'il est déjà ouvert.
cur_path$ = ActiveDocument.Path
annee$ = year(Date)
Dim xlAppList As Excel.Application
Dim xls As Excel.Workbook
Dim ExcelFile
ExcelFile = "U:\Macro FAX\REPORTING\report_bei.xls"
On Error Resume Next
Set xlAppList = GetObject(ExcelFile, "Excel.Application")
If xlAppList Is Nothing Then
Set xlAppList = CreateObject("Excel.Application")
End If
On Error GoTo 0
xlAppList.Visible = True
Set xls = xlAppList.Workbooks.Open(ExcelFile)
Rem Ecriture dans la dernière ligne du tableau.
dercell = Range("A1").End(xlDown).Row + 1
chrono$ = xlAppList.Cells(dercell - 1, 1).Value + 1
xlAppList.Cells(dercell, 1) = chrono$ 'Calcul du chrono
xlAppList.Cells(dercell, 2) = emet$
xlAppList.Cells(dercell, 3) = dest$
xlAppList.Cells(dercell, 4) = soc$
xlAppList.Cells(dercell, 5) = noaff$
xlAppList.Cells(dercell, 6) = class$
xlAppList.Cells(dercell, 7) = nomapp$
xlAppList.Cells(dercell, 8) = objet$
xlAppList.Cells(dercell, 9) = datechrono$
xlAppList.Range(Cells(dercell, 1), Cells(dercell, 9)).Borders(xlEdgeLeft).Weight = xlMedium
xlAppList.Range(Cells(dercell, 1), Cells(dercell, 9)).Borders(xlEdgeRight).Weight = xlMedium
xlAppList.Range(Cells(dercell, 1), Cells(dercell, 9)).Borders(xlEdgeBottom).Weight = xlMedium
xlAppList.Range(Cells(dercell, 1), Cells(dercell, 9)).Borders(xlInsideVertical).Weight = xlMedium
xlAppList.Cells(dercell + 1, 1).Select
'Sauvegarde et fermeture de l'application
ActiveWorkbook.Save
ActiveWorkbook.Close False
xlAppList.Quit
chrono$ = NumPrefix(CInt(chrono$), 3)
Rem Choix de la feuille à ouvrir en fonction du type de doc. choisi
If type_chro$ = "F" Then
fich_nom$ = "FS_" + annee$ + "_" + chrono$ + "_" + objet$ + ".doc"
full_path$ = cur_path$ + "\FAXS\FAXS_SENT" + fich_nom$
End If
If type_chro$ = "C" Then
Sheets("Courrier").Select
End If
If type_chro$ = "N" Then
Sheets("Notes et CR").Select
End If
'Sauvegarde du document dans le dossier de stockage.
ActiveDocument.SaveAs full_path$
MsgBox ("Votre document est sauvegardé sous le nom : " + fich_nom$)
Rem ----FIN----
Rem #####
Rem-----------DEFINITION DES CHAMPS DE RENVOI DANS LE DOC---------------
majchamps:
Selection.HomeKey Unit:=wdStory
ActiveWindow.View.ShowFieldCodes = True
ActiveDocument.Paragraphs(1).Range.Select
Selection.Delete
Selection.Fields.Add Range:=Selection.Range, Text:="set emet " + Chr(34) + emet$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set dest " + Chr(34) + dest$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set noaff " + Chr(34) + noaff$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set soc " + Chr(34) + soc$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set class " + Chr(34) + class$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set nomapp " + Chr(34) + nomapp$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set objet " + Chr(34) + objet$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set datechrono " + Chr(34) + datechrono$ + Chr(34), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set chrono " + Chr(34) + chrono$ + Chr(34) + Chr(32), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set type_chro " + Chr(34) + type_chro$ + Chr(34) + Chr(32), PreserveFormatting:=False
Selection.Fields.Add Range:=Selection.Range, Text:="set fich_type " + Chr(34) + fich_type$ + Chr(34), PreserveFormatting:=False
ActiveWindow.View.ShowFieldCodes = False
Rem--------------------REMPLISSAGE FICHE RESUME------------------------------------
With Dialogs(wdDialogFileSummaryInfo)
.Title = objet$
.Subject = noaff$ + " / " + class$ + " / " + nomapp$ + " / " + objet$
.Author = emet$
.Keywords = dest$ + " (" + soc$ + ")"
.Execute
End With
GoTo fin
fin:
ActiveDocument.PrintPreview
ActiveDocument.ClosePrintPreview
End Sub
