Sauvegarde=Nom de cellule

Rebonjour le forum.

Je suis dans la partie test de mon programme et j'aitrouver un bug que je n'arrive pas a résoudre.

Pour commencer, voici le code:

Private Sub CommandButton2_Click()
Dim i As Integer, verif As Boolean, Nom As String
Dim classeur As String
Dim fichier1 As String
Dim fichier2 As String
Dim fichier3 As String
Dim fichier4 As String

For i = 1 To Worksheets.Count
    If Worksheets(i).Name = TextCode5.Text Then
        Nom = TextCode5.Text
        verif = True
        Exit For
    End If
Next i

If TextCode5.Text Like "#####" Then
'Part1
If verif = True Then
  Application.ScreenUpdating = False
Acode = TextCode5.Text
classeur = ActiveWorkbook.Name
fichier1 = "C:\Program Files\CrypteInc\Anciens Personnages\" & "P_" & [M3].Value
fichier2 = "P_" & [M3].Value & ".xls"

   Sheets(Acode).Select

   With ActiveSheet
    Cells.Select
    Range("X14").Activate
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
   End With

       Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=fichier1, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Application.DisplayAlerts = True

    Application.DisplayAlerts = False
    Windows(classeur).Activate
    Sheets(Acode).Select
    Sheets(Acode).Delete
    Windows(fichier2).Close
    Application.DisplayAlerts = True

  Application.ScreenUpdating = True
    Unload Me
    USF_Ouverture.Show
End If
Else
    MsgBox "Aucune fiche ne correspond à la recherche"
End If
End Sub

Je l'ai fait en grande partie avec l'enregistreur, donc il n'est pas parfait mais il fonctionne a 99%.

Le 1% qui bug viens de la sauvegarde du fichier. Le fichier créé par la macro est sensé prendre le nom P_CelluleM3.xls.

Si la cellule M3 contient un nom commencant par une minuscule, il n'y a aucun probleme, si se nom commence par une majuscule ... il enregistre le fichier sous P_.xls.

Pouvez vous m'aider ?

Merci d'avance a tous le forum

Peri

Edit1: Après test, si le mot en M3commence par une minuscule mais qu'il y a deux mots, il enregistre P_.xls.

Exemple:

Si m3 = test = P_test.xls

Si m3 = Test = P_.xls devrait être P_Test.xls

Si m3 = test un = P_.xls devrait etre P_Test un.xls

Bonjour

Sans ton fichier c'est facile de te répondre. Le pb peut venir de la définition de fichier2, lorsque tu utilises l'instruction WINDOWS(fichier2).close.

Tu peux déjà essayer de mettre OPTION COMPARE TEXT juste avant le début de ta macro (donc juste avant PRIVATE...)

Tu peux changer

Application.DisplayAlerts = True 
Application.DisplayAlerts = False 
Windows(classeur).Activate 
Sheets(Acode).Select 
Sheets(Acode).Delete
Windows(fichier2).Close 
Application.DisplayAlerts = True

par

Application.DisplayAlerts = False 
Workbooks(Classeur).Sheets(Acode).Delete
Workbooks(fichier2).Close 
Application.DisplayAlerts = True 

Remplace aussi

Sheets(Acode).Select 
With ActiveSheet 
Cells.Select 
Range("X14").Activate 
Selection.Copy 
 Workbooks.Add 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
        :=False, Transpose:=False 
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
        SkipBlanks:=False, Transpose:=False 
End With 

par

With Sheets(Acode)
.Select
'Range("X14").Activate (instruction non nécessaire je pense...)
Cells.Copy 
 Workbooks.Add 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
        :=False, Transpose:=False 
End With 

D'autres améliorations sont possibles.

Amicalement

Dan

Bonjour le forum et merci NadDan pour tes conseils, je vais modifier ma macro pour l'allège un peu de tout se code (vive l'enregistreur de macro).

A force de tourner et retourner le problême dans tous les sences, j'ai trouvé mon problême ...

fichier1 = "C:\Program Files\CrypteInc\Anciens Personnages\" & "P_" & [M3].Value
fichier2 = "P_" & [M3].Value & ".xls" 

Il ma suffit de remplacer [M3].Value par [M3].Text ... tout bête quoi.

Merci encore Nad Dan

Peri