XL 2010 [Résolu] Sauvegarder un fichier sous un nouveau nom

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é.

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

  • Sauvegarder fichier+nouveau nom.zip
    37.5 KB · Affichages: 27
Dernière édition:

Statistiques des forums

Discussions
312 104
Messages
2 085 345
Membres
102 868
dernier inscrit
JJV