[VBA-E]thisworkbook.path

Version imprimable

20/03/2006, 20h52
ogenki

[VBA-E]thisworkbook.path

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

alors voila

j'ai un programme VBA dans lequel je fait des

Code:

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
20/03/2006, 20h55
SfJ5Rpw8

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..

je te donne un exemple d'utilisation

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

Code:

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

20/03/2006, 21h03
jmfmarques

ce qui m'interpelle :

Citation:

mais quand je change mon code de repertoire

c'est quoi "mon code" ?
20/03/2006, 21h05
SfJ5Rpw8

Re: [VBA-E]thisworkbook.path

tu aurai pu nous montrer le code concerné par :

Citation:

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...

c'est du VBA dans un . xls

Code:

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:

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 :D c'est sa mon code...

20/03/2006, 21h08
SfJ5Rpw8

Code:

adress = ThisWorkbook.Path

manquerai pas une lettre !! rajoute option explicit en haut de ton module pour éviter ces erreurs !
20/03/2006, 21h14
ogenki

comment je le rajoute ? quelle sintaxe ?

apres modification de "adresse" le probleme perciste
20/03/2006, 21h18
SfJ5Rpw8

Code:

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 ?
20/03/2006, 21h24
ogenki

non sa va pas mieu...etonant... :(
20/03/2006, 21h26
jmfmarques

Alors : que change-tu de répertoire ? ton code ou un document .xls ?
(juste pour rester tout-à-fait clair)
20/03/2006, 21h33
ogenki

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
20/03/2006, 21h35
jmfmarques

hem !....
20/03/2006, 21h38
ogenki

Citation:

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 ?
20/03/2006, 21h47
SfJ5Rpw8

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

Code:

msgBox Adresse

ou ... mode pas à pas...
20/03/2006, 21h49
jmfmarques

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...) :oops:
21/03/2006, 13h19
ogenki

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:

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
21/03/2006, 23h31
AlainTech

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.
22/03/2006, 13h49
ogenki

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..
22/03/2006, 13h59
SfJ5Rpw8

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:

XlsFiles = FindFiles(adresse, "xls")

et exaline le contenu du tableau xlsFiles dans la fenêtre Espion ...
22/03/2006, 16h40
ogenki

enfait si tu regarde dans ma fonction... je lance en pas a pas.. et dans la fonction il saute le while.. il ne rentre pas dans la boucle..

merci
22/03/2006, 17h14
SfJ5Rpw8

le while dans le findfile ?
23/03/2006, 14h36
ogenki

oui exactement..
23/03/2006, 14h42
SfJ5Rpw8

manque pas un \ ?

Code:

test = Dir(Repertoire & "\*." & Extension)
23/03/2006, 14h59
ogenki

sa a l'air de marché mintenan :D je ferme le post... j'en créeré un autre en cas de probleme..

MERCI!! :D :D