Fermeture selon nom

[barth66]

Bonjour à tous,

voila en fait j'ai une macro qui m'ouvre plusieurs fichiers, je copie un onglet puis j'aimerai que la macro me ferme tous les classeurs commencant par stock, j'utilise ce code mais il me ferme que le classeur ou il y a la macro et pas les autres.

Dim Wb As Object

For Each Wb In Application.Workbooks
If Left(Wb.Name, 1) = S And Wb.Name <> ThisWorkbook.Name Then
On Error Resume Next
Wb.Saved = False
Wb.Close
End If
Next Wb
ThisWorkbook.Saved = False
ThisWorkbook.Close
End Sub

Auriez vous la solution ??

Merci d'avance

 

[Papou-net]

Re : Fermeture selon nom

Bonjour Barth66,

Peut-être en mettant le S entre guillemets :

Dim Wb As Object

For Each Wb In Application.Workbooks
If Left(Wb.Name, 1) = "S" And Wb.Name <> ThisWorkbook.Name Then
On Error Resume Next
Wb.Saved = False
Wb.Close
End If
Next Wb
ThisWorkbook.Saved = False
ThisWorkbook.Close
End Sub

Cordialement.

 

[barth66]

Re : Fermeture selon nom

Boum merci beaucoup, j'suis trop bete par contre derniere petite question il me demande encore si je veux enregistrer alors que je ne veux pas !!!

Tu aurais une idée de pourquoi ?

merci encore

 

[Papou-net]

Re : Fermeture selon nom

Boum merci beaucoup, j'suis trop bete par contre derniere petite question il me demande encore si je veux enregistrer alors que je ne veux pas !!!

Tu aurais une idée de pourquoi ?

merci encore

Oui, je pense qu'il faut mettre Wb.Saved = True, ce qui veut dire à VBA que le fichier a déjà été enregistré (ce n'est pas évident à comprendre du premier coup).

Cordialement.

 

[Papou-net]

Re : Fermeture selon nom

RE :

Ou encore en une seule ligne :

wb.Close SaveChanges:=False

Là, c'est la logique inverse.

Cordialement.

 

[barth66]

Re : Fermeture selon nom

Nickel merci encore,

et derniere petite question lors de ma macro j'ai une boite de dialogue qui s'affiche "attention lors de cette opération les cellules ne seront plus fusionné" un code pour répondre automatiquement OK ??

aprés je ne vous embete plus promis lol

merci encore

 

[JCGL]

Re : Fermeture selon nom

Bonjour à tous,

Peux-tu essayer :

Application.DisplayAlerts = 0

A+ à tous

 

[Papou-net]

Re : Fermeture selon nom

RE :

Au lieu d'un MsgBox, il est préférable d'utiliser un WScript (merci à Staple1600).

Exemple :

Sub Message(Delai As Byte)
Dim WshShell, Mess
Set WshShell = CreateObject("WScript.Shell")
Mess = WshShell.Popup("Attention, lors de cette opération les cellules ne seront plus fusionnées", Delai, "Avertissement", 0)
End Sub

Cette macro affiche un message pendant 2 secondes. A toi de changer le délai par celui qui te convient, dans la ligne d'appel de la macro.

A +

Cordialement.

Edit : Salut JC

 

[barth66]

Re : Fermeture selon nom

Merci pour vos réponse,

Jcgl: cela ne fonctionne pas malheursement ou alors je le place mal dans le code

Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Application.DisplayAlerts = 0
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Application.DisplayAlerts = 0
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Application.DisplayAlerts = 0
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Application.DisplayAlerts = 0
ActiveWindow.SmallScroll Down:=-12

en fait c'est dés que je supprime la colonne cela me demande si je suis sur de vouloir continuer car les cellules ne seront plus fusionné mais je n'arrive pas à établir de réponse automatique OK.

un autre code ?

 

[JCGL]

Re : Fermeture selon nom

Bonjour à tous,

Peux-tu essayer :

Application.DisplayAlerts = 0
Columns("F:F").Delete Shift:=xlToLeft
Columns("G:G").Delete Shift:=xlToLeft
Columns("J:J").Delete Shift:=xlToLeft
Columns("A:A").Delete Shift:=xlToLeft
Application.DisplayAlerts = 1

A+ à tous

 

[barth66]

Re : Fermeture selon nom

toujours pas ...

Et je ne sais pas comment je pourrais envoyer le fichier comme c'est une macro qui ouvre d'autres fichiers...

Voici le code entier ...

Rows("1:5").Select
Selection.Delete Shift:=xlUp
Range("H1").Select

With Range("A9:AA" & [L65000].End(xlUp).Row)
.UnMerge
.SpecialCells(xlCellTypeBlanks).Delete
End With
Cells.EntireColumn.AutoFit

Application.DisplayAlerts = 0
Columns("F:F").Delete Shift:=xlToLeft
Columns("G:G").Delete Shift:=xlToLeft
Columns("J:J").Delete Shift:=xlToLeft
Columns("A:A").Delete Shift:=xlToLeft
Application.DisplayAlerts = 1
ActiveWindow.SmallScroll Down:=-12

Range("A1").Select

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Extraction par Succ_Référence").Select

ActiveSheet.PivotTableWizard _
SourceType:=xlDatabase, _
SourceData:="Extraction par Succ_Référence!R1C1:R25457C8", _
TableDestination:="Feuil1!R1C1", _
TableName:="MonTCD"

Sheets("Feuil1").Select
Cells(1, 1).Select


With ActiveSheet.PivotTables("MonTCD").PivotFields("U.O.")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("MonTCD").AddDataField ActiveSheet. _
PivotTables("MonTCD").PivotFields("Valeur Stock"), _
"Somme de Valeur Stock", xlSum

Sheets("Feuil1").Select
Columns("A:B").Select
Selection.Copy
Windows("Macro Stock Mort.xlsm").Activate
Sheets("Feuil3").Select

Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False