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
| Sub liste_des_macros_v3_JMQ()
'==============================================================================================
'http://www.developpez.net/forums/d852635/logiciels/microsoft-office/excel/macros-vba-excel/ouverture-feuille-excel-via-feuille-excel/
'
' arrangé pour JonathanMQ par Radinor
' ouvre, et ferme séquentiellement chaque classeur de la feuille "liste_macros" du
' classeur "maître".
' Pour application : écrit le "fullname" des dits classeurs sur la feuille "liste_macros"
' du classeur "maître".
' Ne doit pas fermer ni ouvrir les classeurs déjà ouverts. Cette macro traite uniquement le
' cas des classeurs ouverts en début de macro.
' Ne sont pas traités non plus tous les cas d'erreur d'ouverture.
' On peut aussi écrire sur un fichier texte fic2. Ce qui va nous servir à écrire les erreurs
' d'ouverture des classeurs
'===============================================================================================
'---------------------------------------------------
' classeurs ouverts
'------------------
Dim t_cls_ouverts(100) As String
Dim i As Integer, cls_ouverts As Integer
Dim cl As Workbook
Dim nb_cls_ouverts As Integer
Dim cl_ouvert As Boolean
'
'stocker les "FullName" des classeurs ouverts
'
i = 0
For Each cl In Workbooks
i = i + 1
t_cls_ouverts(i) = cl.FullName
Next
nb_cls_ouverts = i
'----------------------------------------------------
' feuille de la liste des classeur à lister
'------------------------------------------
Dim objcl_liste_cl As Workbook ' classeur objet
Dim cl_liste_cl_name As String ' classeur.name String name
Dim fl_liste_cl As String ' feuille String
fl_liste_cl = "liste_classeurs" ' affectation nom feuille
'--------------------------------
' feuille résultats listes macros
'--------------------------------
Dim objcl_liste_macros As Workbook ' classeur objet
Dim Fl_liste_macros As String ' feuille String
Fl_liste_macros = "liste_macros" ' affectation nom feuille
' référencer classeur "macros_vba_excel.xls"
Set objcl_liste_macros = Workbooks("macros_vba_excel.xls")
' initialisation contenu cellules (ce n'est pas suffisant mais ne connaît pas mieux)
objcl_liste_macros.Sheets(Fl_liste_macros).Cells.ClearContents
'------------------
' classeur à lister
'------------------
Dim objcl_cl_a_lister As Workbook ' classeur objet
Dim cl_cl_a_lister As String ' classeur String fullname
Dim cl_cl_a_lister_open As Boolean ' classeur à lister déjà ouvert
Dim ajout As Double ' nb lignes totale des macros
Dim xlUpdateLinksNever ' ouvrir sans les liens
'
Dim err_open As Boolean ' erreur ouverture classeur
'
' dichier texte en sortie
'
Dim file2
Dim fic2 As String
file2 = FreeFile
fic2 = "G:\informatique\programmation\VBA excel\vbproject\20091219_liste_des_macros_mouchard.txt"
Open fic2 For Output As file2
'------------------------
ajout = 0 ' init compteur des lignes macros
'---------------------------------------------------------------------------------------------
' parcourir la liste des classeurs à lister
'---------------------------------------------------------------------------------------------
i = 1
'------------------------------- boucle sur les classeurs -------------------------------------
While objcl_liste_macros.Sheets("liste_classeurs").Cells(i, 1) <> ""
'--------------------------- boucle sur un classeur ---------------------------------------
err_open = False ' init erreur ouverture à faux
cl_cl_a_lister_open = False ' init classeur à lister ouvert à faux
'affectation fullname du classeur à lister
cl_cl_a_lister = objcl_liste_macros.Sheets("liste_classeurs").Cells(i, 1)
' regarder les classeurs ouverts pour ne pas confondre les cas d'erreurs d'ouverture
' de classeurs déjà ouvert avec des classeurs qui auraient divers problèmes d'ouverture
' qu'on ne saurait pas distinguer
If Not IsOuvert(cl_cl_a_lister, nb_cls_ouverts, t_cls_ouverts, cl_ouvert) Then
On Error Resume Next ' traiter cas erreur
' ouverture classeur à lister sans mise à jour des liens
Set objcl_cl_a_lister = Workbooks.Open(cl_cl_a_lister, UpdateLinks:=xlUpdateLinksNever) ' => activation automatique ?
If Err > 0 Then ' erreur ouverture
MsgBox "Erreur " & Err & " / problème ouverture fr " & cl_cl_a_lister
Print #file2, "Erreur " & Err & " / problème ouverture fr " & cl_cl_a_lister
err_open = True
Err.Clear
End If
Else
Set objcl_cl_a_lister = Workbooks(Right(cl_cl_a_lister, _
InStr(StrReverse(cl_cl_a_lister), "\") - 1))
objcl_cl_a_lister.Activate
cl_cl_a_lister_open = True ' init classeur à lister déja ouvert à vrai
End If
objcl_liste_macros.Sheets("liste_macros").Cells(i, 1) = _
objcl_liste_macros.Sheets("liste_classeurs").Cells(i, 1)
If Not err_open Then ' fermer le classeur
If Not cl_cl_a_lister_open Then ' s'il n'était pas ouvert
ActiveWorkbook.Close False ' fermeture
Set objcl_cl_a_lister = Nothing ' libérer la ressource
End If
End If
i = i + 1
'--------------------------- fin boucle sur un classeur -------------------------------------
Wend
'------------------------------- fin boucle sur les classeurs -----------------------------------
Close file2
End Sub
Public Function IsOuvert(cl_a_lister, nb_cls_ouverts, ByRef t_cls_ouverts() As String, cl_ouvert) As Boolean
Dim i As Integer
IsOuvert = False
For i = 1 To nb_cls_ouverts
If cl_a_lister = t_cls_ouverts(i) Then
IsOuvert = True
Exit For
End If
Next i
End Function |
Ouverture d'une feuille excel via une autre feuille excel.
Répondre avec citation
..quand c'est le cas !
Partager