Discussion :

[bybelos33]

Mon problème est le suivant : Je lance une macro qui remplit correctement ma feuille Excel avec des appels à de userforms, différents modules,.... à la fin de la macro j'enregitre le fichier sans problème particulier.
Ensuite je regarde le résultat, sans faire aucune modification et je sors d'Excel.
Il me demande d'enregistrer ????, si je dis oui pas de problème je peux ré-ouvrir le fichier, sinon impossible de l'ouvrir même en désactivant les macros ???

Quelqu'un a t'il une idée ???

[Maxence HUBICHE]

On verrait la macro, ca aiderait peut-être non ?

Je pose la question parce que, comme j'ai oublié ma boule de cristal chez moi ce matin ...

[bybelos33]

Je veux bien envoyer la macro mais il faut un site FTP. Je vous envoie les 3 macro principales qui renvoient vers d'autres macro...si cela peut aider

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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
 
Public myDir As String
Public Options As String
Public Fso As Object
Public Num_nom As String
Public Niveau As Integer, Niv_Max As Integer
Public Nom_feuille As String, Pref_code1 As String, Pref_code2 As String, Long_pref As Integer
Public Debut_ligne As Integer
 
Sub Main()
 
 
Dim Temp As String
Dim Nb_feuille As Integer
Dim I As Integer
 
Set Fso = CreateObject("Scripting.FileSystemObject")
 
'---------------------------------------------------------
' Test la présence d'un fichier BOM_TEMP.xls et le détruit
'---------------------------------------------------------
myDir = Application.Workbooks("Nomenclature-GB.xls").Path & Chr(92)
 
If Fso.fileexists(myDir + "BOM_TEMP.xls") = True Then
    Fso.deletefile myDir & "BOM_TEMP.xls"
End If
 
'Récup numéro nomenclature
Num_nom = UCase(UserForm1.TextBox1.Text)
If Left(Num_nom, 2) <> "SM" Then
    Num_nom = "SM" + Num_nom
End If
'validation longueur numéro
If Len(Num_nom) <> 9 And Len(Num_nom) <> 11 Then
    MsgBox "Longueur du code éronnée"
    Exit Sub
Else
    Open myDir + "Num_nom.txt" For Output As 1#
    Print #1, Num_nom
    With UserForm1
        If .OptionButton1 = True Then
            Options = "01000"
        Else
            If .OptionButton3 = True Then
                Options = "00100"
            Else
                If .OptionButton5 = True Then
                    Options = "00010"
                Else
                    If .OptionButton4 = True Then
                        Options = "00001"
                    Else
                        Options = "00000"
                    End If
                End If
            End If
        End If
        If .CheckBox1 = True Then
            Options = Options + "1"
        Else
            Options = Options + "0"
        End If
        If .CheckBox2 = True Then
            Options = Options + "1"
        Else
            Options = Options + "0"
        End If
    End With
    Print #1, Options
    Close #1
End If
 
'on ferme la msgbox
Unload UserForm1
Userform2.Show
 
 
End Sub
 
Sub Choix()
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''On désactive le screen updating''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'Affiche le sablier
Application.Cursor = xlWait
 
Application.DisplayAlerts = False
 
'Demande de création d'une nomenclature simple
If Left(Options, 6) = "000000" Then
    Call Nomenclature_simple
End If
 
'Demande de création d'une arbo
If Mid(Options, 2, 1) = "1" Then
    Call Arbo
End If
 
'Demande de création d'une nomenclature générale multi-feuilles
If Mid(Options, 3, 1) = "1" Then
    Call Sous_nom_multiple
End If
 
'Demande de création d'une nomenclature générale mono-feuille
If Mid(Options, 4, 1) = "1" Then
    Call Sous_nom_simple
End If
 
'Demande de création de création d'un dossier PDF
If Mid(Options, 5, 1) = "1" Then
    Call Sous_nom_multiple
    Call Copie_PDF
End If
 
'Effacement des userforms
Unload Userform2
 
'Effacement du sablier
Application.Cursor = xlDefault
 
'Suppression du bouton de génération nomenclature
If Mid(Options, 2, 1) <> "1" Then
    Worksheets(2).Activate
    ActiveSheet.Shapes("CommandButton2").Select
    Selection.Delete
End If
 
Application.DisplayAlerts = True
If Fso.fileexists(myDir + "BOM_TEMP.xls") = True Then
    '--------------------------------
    'Activation des liens hypertexte
    '--------------------------------
    If Range("C4") <> "" And Right(Options, 1) = "1" Then
        Call lien
    End If
 
    '-------------------------------------------
    'Préparation du nom et sauvegarde du fichier
    '-------------------------------------------
    Temp = CStr(Format(Date, "YYMMDD"))
    Temp = Left(Temp, 2) + "-" + Mid(Temp, 3, 2) + "-" + Right(Temp, 2) + "-"
 
 
    Application.Workbooks("Nomenclature-GB.xls").Worksheets(2).Activate
    If Mid(Options, 2, 1) = "1" Then
        ProjectName = Temp + "Arbo-" & Cells(5, 7).Value & "-" & Cells(5, 7).Value
        ProjectName = Replace(ProjectName, "/", "-")
        ProjectName = Replace(ProjectName, " ", "")
        ProjectName = Replace(ProjectName, ".", "")
        ProjectName = Replace(ProjectName, ",", "")
        ProjectName = ProjectName + ".xls"
    Else
        ProjectName = "" & Cells(2, 2).Value & Cells(2, 4 + Niv_Max).Value & "-" & Cells(2, 5 + Niv_Max).Value
        ProjectName = Replace(ProjectName, "/", "-")
        ProjectName = Replace(ProjectName, " ", "")
        ProjectName = Replace(ProjectName, ".", "")
        ProjectName = Replace(ProjectName, ",", "")
        ProjectName = ProjectName + ".xls"
    End If
 
    On Error Resume Next
 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''On active le screen updating''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Application.ScreenUpdating = True
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
    Sheets(2).Select
    Range("B4").Select
 
    With Workbooks("Nomenclature-GB.xls").VBProject.VBComponents
        .Remove .Item("DataAccess")
        .Remove .Item("Fonctions")
        .Remove .Item("Impression_PDF")
        .Remove .Item("Liens_hypertexte")
        .Remove .Item("MiseformeBom")
        .Remove .Item("ModifArticle")
        .Remove .Item("ModifTexte")
        .Remove .Item("PageDeGarde")
        .Remove .Item("PiedPage")
        .Remove .Item("Regroupement")
        .Remove .Item("RepTopo")
    End With
 
 
 
Begin:
 
    File = Application.GetSaveAsFilename(initialfilename:=ProjectName)
 
    If File <> False Then
 
        ActiveWorkbook.SaveAs filename:=File
 
        If Err.Number <> 0 Then
            Err.Clear
            GoTo Begin
        End If
    Else:
        MsgBox "Il faut sauvegarder le fichier Nomenclature-GB.xls sous un autre nom", _
        vbExclamation, "Nomenclature"
        GoTo Begin
    End If
Else
    Workbooks.Close
End If
 
End Sub