[VBA-E]thisworkbook.path

**ogenki** · 20/03/2006, 20h52

bonjour ( je sais plus ou posté avec les changement de forum...

)

alors voila

j'ai un programme VBA dans lequel je fait des

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Adresse = ThisWorkbook.Path

pour pouvoir transporter mon code plus facilement ( utilisation sur plusieur machines)

mon probleme est le suivant.. il ne se reinitialise pas..

je m'explique...le but est de recuperé le nom de tout les .xls d'un repertoire... mais quand je change mon code de repertoire...il me renvoi les .xls du premier repertoire dans lequel je l'ai mis...

pourquoi il ne se reinitialise pas ?

( je pense avoir etait clair dites si je me trompe.. si vous avez besoin de plus de detail...)

merci

**SfJ5Rpw8** · 20/03/2006, 20h55

ThisWorkbook.path ... renvoi le répertoire ou est stocké le classeur contenant ton code... maintenant faut voir comment tu l'utilise ensuite ta variable adresse..

**ogenki** · 20/03/2006, 21h00

je te donne un exemple d'utilisation

si j'apuis sur un de mes boutons sa me donne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Public Sub SaveFiles()
'sauvegarde le .xls dans sauvegarde
Dim cmp, NomFich
Adresse = ThisWorkbook.Path
NomFich = Application.Caller
DateInverse = Split(Date, "/")
DateInverse = DateInverse(2) & "_" & DateInverse(1) & "_" & DateInverse(0) & "_"
    FileCopy Adresse & "\" & NomFich & ".xls", Adresse & "\" & "sauvegarde\" & _
    NomFich & DateInverse & Replace(Str(Time), ":", "-") & ".xls"
    Workbooks.Open Filename:=Adresse & "\" & NomFich & ".xls"
 
End Sub

**jmfmarques** · 20/03/2006, 21h03

ce qui m'interpelle :

mais quand je change mon code de repertoire

c'est quoi "mon code" ?

**SfJ5Rpw8** · 20/03/2006, 21h05

tu aurai pu nous montrer le code concerné par :

Envoyé par ogenki

je m'explique...le but est de recuperé le nom de tout les .xls d'un repertoire... mais quand je change mon code de repertoire...il me renvoi les .xls du premier repertoire dans lequel je l'ai mis...

**ogenki** · 20/03/2006, 21h06

c'est du VBA dans un . xls

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
Private Sub Workbook_Open()
    Dim butTop, butLeft, Bouton, butHeight, butWidth, Adresse
    Dim k
    Dim lastline, winindex
    Dim ligne
    Dim Name
    Dim XlsFiles() As String
    Dim DocFiles() As String
    lastline = 1
    ligne = 0
   Application.DisplayAlerts = False
   adress = ThisWorkbook.Path
    'MkDir "C:\Documents and Settings\avaysse\Mes documents\sauvegarde"
    XlsFiles = FindFiles(Adresse, "xls")
    DocFiles = FindFiles(Adresse, "doc")
    For i = LBound(XlsFiles) To UBound(XlsFiles)
        If XlsFiles(i) = "test2.xls" Then GoTo sortie
        Workbooks.Open Filename:= _
            Adresse & XlsFiles(i)
            Range("A1:N6").Select 'selection des cellules a copier
            Selection.Copy ' copie des cellules
            Workbooks("test2.xls").Worksheets(1).Cells(lastline, 1).PasteSpecial Paste:=xlFormats 'copie des format
            Workbooks("test2.xls").Worksheets(1).Cells(lastline, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Workbooks(("test2.xls")).Activate
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''affichage des %
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            Range("h" & lastline + 5).Select
            Selection.Font.ColorIndex = 1
            Range("i" & lastline + 5).Select
            Selection.Font.ColorIndex = 1
            Range("j" & lastline + 5).Select
            Selection.Font.ColorIndex = 1
            Range("k" & lastline + 5).Select
            Selection.Font.ColorIndex = 1
            Range("l" & lastline + 5).Select
            Selection.Font.ColorIndex = 1
            Range("m" & lastline + 5).Select
            Selection.Font.ColorIndex = 1
            Selection.FormatConditions.Delete
            Range("n" & lastline + 5).Select
            Selection.Font.ColorIndex = 1
            Selection.FormatConditions.Delete
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' creation des liens vers les classeurs source
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            '''''''''''''''''''''''''''''''''''
            ''''     position du bouton    ''''
            '''''''''''''''''''''''''''''''''''
            butTop = Range("g" & lastline + 7).Top
            butLeft = Range("g" & lastline + 7).Left
            butHeight = Range("g" & lastline + 7).Height
            butWidth = Range("g" & lastline + 7).Width
            '''''''''''''''''''''''''''''''''''
            ''''       code du bouton      ''''
            '''''''''''''''''''''''''''''''''''
            Set Bouton = ActiveSheet.Buttons.Add(Left:=butLeft, Top:=butTop, Width:=butWidth, Height _
            :=butHeight * 2)
            With Bouton
                .OnAction = "Openfiles"
                Name = Split(XlsFiles(i), ".")
                .Name = Name(0)
                .Caption = "consulter"
            End With
 
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' creation des liens vers les documents word
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            '''''''''''''''''''''''''''''''''''
            ''''     position du bouton    ''''
            '''''''''''''''''''''''''''''''''''
            butTop = Range("i" & lastline + 7).Top
            butLeft = Range("i" & lastline + 7).Left
            butHeight = Range("i" & lastline + 7).Height
            butWidth = Range("i" & lastline + 7).Width
            '''''''''''''''''''''''''''''''''''
            ''''       code du bouton      ''''
            '''''''''''''''''''''''''''''''''''
            Set Bouton = ActiveSheet.Buttons.Add(Left:=butLeft, Top:=butTop, Width:=butWidth, Height _
            :=butHeight * 2)
            With Bouton
                .OnAction = "OpenWorddocs"
                 Name = Split(XlsFiles(i), ".")
                 Name = Replace(Name(0), " ", "")
                .Name = Name
                Name = Split(XlsFiles(i), ".")
                .Caption = "fiche projet"
            End With
 
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''sauvegarde des documents excel
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            '''''''''''''''''''''''''''''''''''
            ''''     position du bouton    ''''
            '''''''''''''''''''''''''''''''''''
            butTop = Range("k" & lastline + 7).Top
            butLeft = Range("k" & lastline + 7).Left
            butHeight = Range("k" & lastline + 7).Height
            butWidth = Range("k" & lastline + 7).Width
            '''''''''''''''''''''''''''''''''''
            ''''       code du bouton      ''''
            '''''''''''''''''''''''''''''''''''
            Set Bouton = ActiveSheet.Buttons.Add(Left:=butLeft, Top:=butTop, Width:=butWidth, Height _
            :=butHeight * 2)
            With Bouton
                .OnAction = "SaveFiles"
                .Name = Name(0)
                .Caption = "sauve et ouvre"
            End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' fermeture de toute les fenetres et vidé le clipboard
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            Application.DisplayAlerts = False
            Workbooks(XlsFiles(i)).Close False
            OpenClipboard 0
            EmptyClipboard
            CloseClipboard
            Application.DisplayAlerts = True
            lastline = lastline + 10
 
sortie:
Next
Application.DisplayAlerts = True
End Sub

et le module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Dim FicDoc
Dim DocFiles
Dim XlsFiles
Dim Adresse
 
 
Public Sub OpenWorddocs()
Adresse = ThisWorkbook.Path
'necesite d'activer la reference Microsoft Word xx.x Object Library
    Dim DocPath As String
    Dim appWrd As Word.Application
    Dim DocWord As Word.Document
    Nom = Application.Caller
    Set appWrd = New Word.Application
    DocPath = Adresse & "\" & Nom & ".doc"
    If Dir(DocPath) <> "" Then
        Set DocWord = appWrd.Documents.Open(DocPath)
    Else
        Set docWrd = appWrd.Documents.Add
        docWrd.SaveAs DocPath
    End If
    appWrd.Visible = True
 
End Sub
 
    Public Function FindFiles(ByVal Repertoire As String, ByVal Extension As String) As String()
' recherche tout les document du repertoire avec l'extention voulu
    Dim test As String, cmpt As Integer, tabTemp() As String
    test = Dir(Repertoire & "*." & Extension)
 
 
    While test <> ""
        ReDim Preserve tabTemp(cmpt)
            tabTemp(cmpt) = test
            cmpt = cmpt + 1
            test = Dir
    Wend
    FindFiles = tabTemp
 
 
End Function
 
Public Function Openfiles()
Dim FileToOpen
Adresse = ThisWorkbook.Path
FileToOpen = Application.Caller
 
Workbooks.Open Adresse & "\" & FileToOpen & ".xls", , True
End Function
 
Public Sub SaveFiles()
'sauvegarde le .xls dans sauvegarde
Dim cmp, NomFich
Adresse = ThisWorkbook.Path
NomFich = Application.Caller
DateInverse = Split(Date, "/")
DateInverse = DateInverse(2) & "_" & DateInverse(1) & "_" & DateInverse(0) & "_"
    FileCopy Adresse & "\" & NomFich & ".xls", Adresse & "\" & "sauvegarde\" & _
    NomFich & DateInverse & Replace(Str(Time), ":", "-") & ".xls"
    Workbooks.Open Filename:=Adresse & "\" & NomFich & ".xls"
 
End Sub

voila

c'est sa mon code...

**SfJ5Rpw8** · 20/03/2006, 21h08

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 adress = ThisWorkbook.Path

manquerai pas une lettre !! rajoute option explicit en haut de ton module pour éviter ces erreurs !

**ogenki** · 20/03/2006, 21h14

comment je le rajoute ? quelle sintaxe ?

apres modification de "adresse" le probleme perciste

**SfJ5Rpw8** · 20/03/2006, 21h18

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Option Explicit

à placer en haut de ton module .. cela oblige la déclaration des variables... et permet de détecter plus facilement les erreurs de frappes sur la saisie de leur nom...

Sinon avec Adresse , ton code fonctionne-t'il mieux ?

**ogenki** · 20/03/2006, 21h24

non sa va pas mieu...etonant...

**jmfmarques** · 20/03/2006, 21h26

Alors : que change-tu de répertoire ? ton code ou un document .xls ?
(juste pour rester tout-à-fait clair)

**ogenki** · 20/03/2006, 21h33

les 2 enfait...vu que mon code est dans mon .xls

je fait un couper/coller...vers une nouvelle adresse..( nimporte ou enfait.. exemple je passe de

C:\Documents and Settings\avaysse

a

C:\Documents and Settings\avaysse\Mes documents

mais sa recupere quand-meme les .xls de la premiere adresse

**jmfmarques** · 20/03/2006, 21h35

hem !....

**ogenki** · 20/03/2006, 21h38

hem !....

pas tres explicite tout sa...j'ai pas dit que j'etait un pro du VBA..

[EDIT] le seul moyen serais de faire des copier coller de mon code dans un nouveau .xls ?

ill n'y a pas moyen de reinitialisé adresse ?

**SfJ5Rpw8** · 20/03/2006, 21h47

? est-tu sur de ce que tu avance .? vérifie la valeur de ton thisworkook.path... rajoute par exempler des

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

msgBox Adresse

ou ... mode pas à pas...

**jmfmarques** · 20/03/2006, 21h49

et si le code est mis dans un xla ... dans un répertoire différent du xls ?
(je n'ai plus Excel "moderne"...mais ma seule mémoire...)

**ogenki** · 21/03/2006, 13h19

j'ai mis des Msgbox adresse partout...et se que je comprend c'est qu'il reconais bien mon nouveau chemin..mais qu'il recupere quand meme les ancien fichier ( si vous avez compris mon code vous avez vu que un des bouton crée un .doc dans le meme repertoire... bin il l'a bien crée dans le nouveau chemin..comprend pas...)

aprés avoir regardé ou sa pouvais reelement planté..j'ai regardé dans la fonction qui recherche tout les .xls...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public Function FindFiles

en me disant qu'il recherche dans le mauvais repertoire.. je fait donc un MsgBox repertoire... et il me renvoi bien le nouveau repertoire.. comprend plus rien moi..

si quelqun a une idée.. merci

**AlainTech** · 21/03/2006, 23h31

ThisWorkbook.Path te renverra toujours le chemin du classeur dans lequel se trouve le code exécuté en ce moment.

Jamais le chemin d'un classeur sur lequel tu interviens.

**ogenki** · 22/03/2006, 13h49

bin oui...mais non... sa marche pas...

il me renvoi bien la position du classeur.. mais il ne fait pas la recherche dans le repertoire... je comprend rien..

**SfJ5Rpw8** · 22/03/2006, 13h59

et encore une fois tu est sur de ton analyse ... et que Findfiles..ne te renvoi pas la bonne liste de fichiers... pour cela .. place une point d'arrêt (F9) aprés la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part