rendre invisible une fenetre [Résolu]

[khadouja]

voilà mon code , j'aime copier des cellules séparer du fichier" saisie" vers le fichier "etat", je réussi à le faire mais il y a l'ouverture du fichier "etat" à chaque copie et c'est génant, si c'est possible de me dire comment faire "coler" sans ouvrir le fichier "etat" à chaque fois.

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
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
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
Function DerLi()
Dim LastRow As Long
  ActiveSheet.UsedRange
  LastRow = Cells.SpecialCells(xlLastCell).Row
  DerLi = LastRow
End Function
Sub Button2_Click()
Dim Sh As Worksheet
Dim Reponse As String
Dim MonNom As String
Dim BonNom As Boolean
Dim LeString
LeString = ":\/?*[]"
Workbooks.Open "d:\lazher\etat.xls"
    Workbooks("etat.xls").Activate
    Workbooks("etat.xls").Worksheets(Sheets.Count).Select
If (Sheets(Sheets.Count).Range("E" & DerLi()).Value <> " ") Then
Cells(DerLi(), 6).ClearContents
Cells(DerLi(), 5).ClearContents
Cells(DerLi(), 7).ClearContents
Cells(DerLi(), 8).ClearContents
Cells(DerLi(), 9).ClearContents
End If
Workbooks("etat.xls").Close True
If (Sheets(Sheets.Count).Range("A" & DerLi() - 2).Value <= 4) Then
    Sheets("sheet1").Select
    Range("B18").Select
    Selection.Copy
    Workbooks.Open "d:\lazher\etat.xls"
    Workbooks("etat.xls").Activate
    Workbooks("etat.xls").Worksheets(Sheets.Count).Select
    Range("B" & DerLi() + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Workbooks("etat.xls").Close True
    Sheets("sheet1").Select
    Range("C18:D18").Select
    Selection.Copy
    Workbooks.Open "d:\lazher\etat.xls"
    Workbooks("etat.xls").Activate
    Workbooks("etat.xls").Worksheets(Sheets.Count).Select
    Range("C" & DerLi()).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(Sheets.Count).Select
    Range("C" & DerLi()).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    Workbooks("etat.xls").Close True
Sheets("sheet1").Select
    Range("B10:J14").Select
    Selection.Copy
    Workbooks.Open "d:\lazher\etat.xls"
    Workbooks("etat.xls").Activate
    Workbooks("etat.xls").Worksheets(Sheets.Count).Select
    Range("D" & DerLi()).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(Sheets.Count).Select
    Range("D" & DerLi()).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    Workbooks("etat.xls").Close True
    Sheets("sheet1").Select
    Range("F18:J18").Select
    Selection.Copy
    Workbooks.Open "d:\lazher\etat.xls"
    Workbooks("etat.xls").Activate
    Workbooks("etat.xls").Worksheets(Sheets.Count).Select
    Range("E" & DerLi()).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Sheets(Sheets.Count).Select
    Range("E" & DerLi()).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    Workbooks("etat.xls").Close True
    Sheets("sheet1").Select
    Range("K18").Select
    Selection.Copy
    Workbooks.Open "d:\lazher\etat.xls"
    Workbooks("etat.xls").Activate
    Workbooks("etat.xls").Worksheets(Sheets.Count).Select
    Range("F" & DerLi()).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(Sheets.Count).Select
    Range("F" & DerLi()).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
     Workbooks("etat.xls").Close True
Sheets("sheet1").Select
    Range("L18").Select
    Selection.Copy
    Workbooks.Open "d:\lazher\etat.xls"
    Workbooks("etat.xls").Activate
    Workbooks("etat.xls").Worksheets(Sheets.Count).Select
    Range("G" & DerLi()).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(Sheets.Count).Select
    Range("G" & DerLi()).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    Range("A" & DerLi()).Value = Range("A" & DerLi() - 1).Value
With Sheets(Sheets.Count).Range("A" & DerLi())
            .Value = .Value + 1
   End With
   Sheets(Sheets.Count).Select
   Range("A" & DerLi()).Select
  With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    Sheets(Sheets.Count).Select
   Range("H" & DerLi()).Select
With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    Sheets(Sheets.Count).Select
   Range("I" & DerLi()).Select
   Range("I" & DerLi()).Value = Range("F" & DerLi()).Value - Range("H" & DerLi()).Value
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
Range("E" & DerLi() + 2).Value = "Total"
Dim rg As Range
Dim rg1 As Range
Dim rg2 As Range
Dim rg3 As Range
Dim rg4 As Range
Set rg = ActiveSheet.Range(Cells(14, 6), Cells(DerLi() - 2, 6))
ActiveSheet.Cells(DerLi(), 6).Formula = "=SUM(" & rg.AddressLocal & " )"
Set rg1 = ActiveSheet.Range(Cells(14, 7), Cells(DerLi() - 2, 7))
ActiveSheet.Cells(DerLi(), 7).Formula = "=SUM(" & rg1.AddressLocal & " )"
Set rg2 = ActiveSheet.Range(Cells(14, 8), Cells(DerLi() - 2, 8))
ActiveSheet.Cells(DerLi(), 8).Formula = "=SUM(" & rg2.AddressLocal & " )"
Set rg3 = ActiveSheet.Range(Cells(14, 9), Cells(DerLi() - 2, 9))
ActiveSheet.Cells(DerLi(), 9).Formula = "=SUM(" & rg3.AddressLocal & " )"
 Workbooks("etat.xls").Close True
    End If
Workbooks.Open "d:\lazher\etat.xls"
    Workbooks("etat.xls").Activate
    Workbooks("etat.xls").Worksheets(Sheets.Count).Select
If Sheets(Sheets.Count).Range("A" & DerLi() - 2).Value >= 5 Then
Do
    BonNom = True
    Reponse = InputBox("Veuillez saisir le n°" _
        + vbCrLf + "du chéquier suivant", _
        "N° du chéquier ", MonNom)
    If Reponse <> "" Then
       'Vérifier que le nom n'existe pas déjà...
        For a = 1 To ActiveWorkbook.Worksheets.Count
            If UCase(Reponse) = UCase(Worksheets(a).Name) Then
                supp = MsgBox( _
                    "Vous possédez une feuille portant déjà ce nom," _
                    + vbCrLf + vbCrLf + _
                    "Désirez-vous la remplacer?.", vbYesNo + vbOKOnly, _
                    "Nom existant déjà")
                If supp = vbYes Then
                    Application.DisplayAlerts = False
                    Worksheets(Reponse).Delete
                    Application.DisplayAlerts = True
                    Exit For
                Else
                    BonNom = False
                    MonNom = Reponse
                    Exit For
                End If
            End If
        Next
 
        'Vérifier que le nombre de caractères du nom ne dépassent 31...
        If Len(Reponse) > 31 Then
            MsgBox "Le nombre de caractères (" & _
                Len(Reponse) & ") de votre nom dépasse" _
                + vbCrLf + " celui permis (31) par excel.", _
                vbCritical + vbInformation, "Nom trop long"
            BonNom = False
            MonNom = Reponse
        End If
 
        'Vérifier l'emploi de caractères interdits...dans le nom
        For a = 1 To Len(LeString)
            If InStr(1, Reponse, Mid(LeString, a, 1), vbTextCompare) > 0 Then
                MsgBox "Les caractères suivants:  " & _
                LeString & "  sont interdits" _
                + vbCrLf + "dans le nom d'une feuille.", _
                vbCritical + vbOKOnly, "Caractère interdit"
                BonNom = False
                MonNom = Reponse
                Exit For
            End If
        Next
    Else
        Exit Sub
    End If
Loop Until BonNom = True
 
Set Sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Sh.Name = Reponse
Columns("A:A").ColumnWidth = 6.29
Columns("B:B").ColumnWidth = 14.86
Columns("C:C").ColumnWidth = 16
Columns("D:D").ColumnWidth = 16
Columns("E:E").ColumnWidth = 16
Columns("F:F").ColumnWidth = 8
Columns("G:G").ColumnWidth = 7.43
Columns("H:H").ColumnWidth = 16
Columns("I:I").ColumnWidth = 24
Cells.Select
    Application.CutCopyMode = False
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
Sheets("Sheet1").Select
    ActiveSheet.Shapes("Text Box 2").Select
    ActiveSheet.Shapes.Range(Array("Text Box 2", "Picture 1")).Select
    Selection.Copy
    Sheets(Sheets.Count).Select
    ActiveSheet.Paste
Sheets("Sheet1").Select
    Range("A7:I12").Select
    Selection.Copy
    Sheets(Sheets.Count).Select
    Range("A7").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Sheets("Sheet1").Select
    Range("A13").Select
    Selection.Copy
    Sheets(Sheets.Count).Select
    Range("A13").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    End If
Workbooks("etat.xls").Close True
End Sub

[repié]

Tu veux pas être un peu plus clair sur ton msg et plus succint dans ton code (du genre cibler l'endroit qui te pose problème) stp

merci

[Commodore]

y manquerait pas encore une ou deux pages de code ?

[Commodore]

sinon, généralement, pour rendre invisible une feuille on utilise le code suivant:

Code :

Worksheets("MaFeuille").Visible=False

De plus, tu ferais mieux d'eviter de trop utiliser .Select et Selection comme tu l'as fait.

ça doit etre un vrai feu d'artifice quand tu lances ta macro...

[repié]

mais ce que je veux c'est que le classeur "etat" lorsque je vais coller les valeurs de quelques cellules du classeur"saisie" , ne s'ouvre pas à chaque fois je fais coller .
pour "select" si je ne l'utilise pas je vais utiliser quoi exactement pour selectionner l'emplacement là où je vais coller, c'est sur il y a une autre astuce :
voilà un code simple : je suis dans la feuille de saisie (un claseur à part)

Code :

si tu affecte ce code à un bouton, tu vas remarquer qu'il ouvre le fichier etat et il colle la valeur et il ferme
ce fichier, si je vais coller plusieurs valeur séparement c'est genant cette ouverture recurrente du fichier"etat.xls"

Eh bin t'as ka faire une sub "ouverture classeur" qui est appelé une seule fois qui ouvre le classeur une fois pour toute

[khadouja]

si je l'ouvre une fois pour toute je fais comment pour basculer de ce classeur vers l'autre, tu peux me donner comment faire suivant l'exemple que je t'ai donné ?

[khadouja]

Merci infinement pour cette remarque précieuse,
voilà le code que j'utilise :
Workbooks("book1.xls").Worksheets("Sheet1").Activate pour basculer d'un fichier à un autre.
Merci

[repié]

donc si j'ai bien compris, tu veux pouvoir pouvoir basculer du classeur "état" vers le classeur en cours (qui varie à chaque fois)

Tu appeles le classeur "Etat" :

Code :

Workbooks("etats").activate

et le classeur en cours

Code :

Thisworkbook.activate

ca t'évite d'avoir à mettre le nom du classeur en cours à chaque fois

[Commodore]

merci de ne pas m'envoyer de MP quand tout le monde peut en profiter...

khadouja
Invité de passage



Inscription: juillet 2006
Messages: 3 un programme comme exemple de mon souci!!!

--------------------------------------------------------------------------------

mais ce que je veux c'est que le classeur "etat" lorsque je vais coller les valeurs de quelques cellules du classeur"saisie" , ne s'ouvre pas à chaque fois je fais coller .
pour "select" si je ne l'utilise pas je vais utiliser quoi exactement pour selectionner l'emplacement là où je vais coller, c'est sur il y a une autre astuce :
voilà un code simple : je suis dans la feuille de saisie (un claseur à part)
sub copie()
Sheets("sheet1").Select
Range("L18").Select
Selection.Copy
Workbooks.Open "d:\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
Range("G" & DerLi()).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("etat.xls").Close True
end sub
si tu affecte ce code à un bouton, tu vas remarquer qu'il ouvre le fichier etat et il colle la valeur et il ferme
ce fichier, si je vais coller plusieurs valeur séparement c'est genant cette ouiverture recurrente du fichier"etat.xls".
j'espère que j'était plus claire.

un bout de réponse:

au lieu de range.select et selection.copy
fait range(<cible>).copy...

[repié]

eh khadouja oublie pas de signaler que le sujet est réolu si c'est le cas!

[Theocourant]

Envoyé par Commodore_Psykopate

De plus, tu ferais mieux d'eviter de trop utiliser .Select et Selection comme tu l'as fait.

ça doit etre un vrai feu d'artifice quand tu lances ta macro...

Moi je dis que c'est un bon début car il/elle a commencé par travailler avec l'enregistreur de macro.

donc +1 pour toi khadouja

mais tu apprendras bien vite que certaines méthodes utilisée par l'enregistreur de macro ne sont pas les meilleures... mais ceci nécessite du temps pour apprendre.

Bon courage

Théo

[repié]

je suis d'accord que "selection.copy" par exemple est l'Element utilisé par l'enregistreur et qu'il est sacrément pratique...


A 1 point près : c'est que quand tu as une macro qui fait un gros traitement en utilisant beaucoup cette fonction, le si agréable Ctrl + C et Ctrl + V est alors à bannir (étant donné qu'ils utilise la même allocation de mémoire).

Et si tu as le malheur de faire Ctrl + C et Ctrl + V sur un autre logiciel pendant que ta macro tourne, cette dernière à des chances de tomber, étant donner qu'elle ne retrouve pas ce qu'elle était censé avoir...

Donc méfiance pour les gros traitement....