Lone-wolf
XLDnaute Barbatruc
Bonjour le Forum
J'ai du mal à écrire ceci dans le code du bouton: Je crée un fichier nommé Classeur C100 ensuite, si le fichier existe en créer un autre sous le nom de Classeur C100 - 1 et ainsi de suite. Merci d'avance.
Edit: j'ai trouvé.
J'ai du mal à écrire ceci dans le code du bouton: Je crée un fichier nommé Classeur C100 ensuite, si le fichier existe en créer un autre sous le nom de Classeur C100 - 1 et ainsi de suite. Merci d'avance.
Edit: j'ai trouvé.
VB:
Private Sub CommandButton1_Click()
Dim plage As Range, cel As Range, rg As Range, i As Long
Dim chemin As String, nom As String, NomFich As String, NvFich As String, Reponse
Application.ScreenUpdating = False
chemin = ThisWorkbook.Path & "\Classeurs\"
With Sheets("Liste")
Set plage = .Range("a3:e" & .Range("e" & Rows.Count).End(xlUp).Row)
plage.AutoFilter field:=4, Criteria1:=ComboBox1, Operator:=xlAnd
Set cel = plage.Find(ComboBox1, , xlValues)
If Not cel Is Nothing Then
End If
End With
With Sheets("Diagnostic")
.Activate
Sheets("Liste").Cells.SpecialCells(xlCellTypeVisible).Copy
Set rg = .Range("a65536").End(xlUp)(2)
rg.PasteSpecial Paste:=xlPasteValues
For i = 3 To 1 Step -1
.Cells(i, 1).EntireRow.Delete
Next i
Application.CutCopyMode = 0
.Range("a1:e1").Font.Bold = True
nom = "Classeur " & .Range("d2") & Mid(.Range("e2"), 3, 3)
Application.Goto .Range("a1")
End With
NomFich = chemin & nom & ".xlsx"
On Error Resume Next
Application.DisplayAlerts = False
Reponse = MsgBox("Le fichier existe déjà" & vbLf _
& vbLf & "Voulez-vous créer un nouveau fichier ?", vbYesNo, "SAUVEGARDE")
If FichierExiste(NomFich) = True Then
NvFich = chemin & nom & " -" & num & ".xlsx"
ActiveSheet.Copy
ActiveSheet.SaveAs Filename:=NvFich, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close True
Name NomFich As NvFich
Unload Me
Sheets("Liste").Activate
ActiveSheet.Range("a3:e65536").AutoFilter
MsgBox "le fichier à bien été enregistré.", , "SAUVEGARDE"
Else
ActiveSheet.Copy
ActiveSheet.SaveAs Filename:=NomFich, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close True
Unload Me
Sheets("Liste").Activate
ActiveSheet.Range("a3:e65536").AutoFilter
MsgBox "le fichier à bien été enregistré.", , "SAUVEGARDE"
End If
End Sub
Public Function FichierExiste(MonFichier As String)
If Len(Dir(MonFichier)) > 0 Then
FichierExiste = True
Else
FichierExiste = False
End If
End Function
Pièces jointes
Dernière édition: