[Déplacé VB6 --> VBA] PATH RELATIF VBA WORD [Résolu]

Messages postés
7
Date d'inscription
jeudi 16 juillet 2009
Dernière intervention
24 juillet 2009
- 20 juil. 2009 à 09:41 - Dernière réponse :
Messages postés
7
Date d'inscription
jeudi 16 juillet 2009
Dernière intervention
24 juillet 2009
- 24 juil. 2009 à 05:20
Bonjour,

j'ai actuellement une application VBA Word qui utilise plusieurs fichiers (création, renommage etc) et je ne parviens pas à utiliser les chemins relatifs pour accéder aux dossiers.

J'ai essayé avec App.path mais aucun succès.

Merci de votre aide

Julien
Afficher la suite 

Votre réponse

3 réponses

Meilleure réponse
Messages postés
7
Date d'inscription
jeudi 16 juillet 2009
Dernière intervention
24 juillet 2009
- 24 juil. 2009 à 05:20
3
Merci
Je viens de trouver la solution pour ceux que ca intéresse :

ThisDocument.path

Ca fonctionne maintenant merci

Julien

Merci julienbouchot 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 88 internautes ce mois-ci

Commenter la réponse de julienbouchot
Messages postés
14010
Date d'inscription
samedi 29 décembre 2001
Dernière intervention
28 août 2015
- 20 juil. 2009 à 10:41
0
Merci
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)
Commenter la réponse de cs_Jack
Messages postés
7
Date d'inscription
jeudi 16 juillet 2009
Dernière intervention
24 juillet 2009
- 24 juil. 2009 à 05:14
0
Merci
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
Commenter la réponse de julienbouchot

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.