Petit soucis pour sauvegarder sous

Re : Petit soucis pour sauvegarder sous

bonjour,

Essaie ce code :

Sub sauver()
Dim nom_fic(100)
Dim reponse As String, nom As String
choisir = MsgBox("Voulez-vous enregistrer ce menu ?", vbYesNo)
reprise:
If choisir = vbYes Then
nom = InputBox("Donnez le numero de semaine" & Chr(13) _
& "Selon cette structure :XX", , "XX")
' seulement de 01 à 52 doivent être possible
If nom = "" Then Exit Sub
rep = ActiveWorkbook.Path
Direction = Dir(rep & "\*.xls")
nbfic = 0
While Direction > ""
nbfic = nbfic + 1
nom_fic(nbfic) = Direction
'MsgBox Nom_fic(nbfic) & " = " & nbfic
Direction = Dir()
Wend
'Stop
'Ouverture
For x = 1 To nbfic
fg = nom_fic(x)
If fg = "menu sem " & nom & ".xls" Then
'Stop
MsgBox ("Ce fichier existe déjà Veuillez modifier "): GoTo reprise
End If
Dim cpt As Integer
On Error Resume Next
Next
'Stop
ActiveWorkbook.SaveCopyAs Filename:= _
"C:\Users\Emmanuel\menu sem " & nom & ".xls"
' si le fichier existe déjà, j'ai un message d'erreur. comment faire pour avoir un retour au msgbox "choisir"
End If
End Sub

Re : Petit soucis pour sauvegarder sous

Chalet53,
Merci pour le temps passé, mais le problème reste. Pour le nom, que ce soit des chiffres ou des lettres, tout est accepté et lors de l'enregistrement, si un fichier porte déjà ce nom la msgbox ne s'ouvre pas et le fichier est écrasé.

Je ne perd pas espoir qu'une bonne âme vienne me secourir
Manu

Re : Petit soucis pour sauvegarder sous

Essaie ceci :
Si tu veux que la saisie ne soit que des chiffres, il faut contrôler la numéricité (ce que je n'ai pas fait)
J'ai forcé en entrée le répertoire "C:\Emmanuel\"

Sub essai()
Dim reponse As String, nom As String
Dim nom_fic(100)
choisir = MsgBox("Voulez-vous enregistrer ce menu ?", vbYesNo)
reprise:
If choisir = vbYes Then
nom = InputBox("Donnez le numero de semaine" & Chr(13) _
& "Selon cette structure :XX", , "XX")
' seulement de 01 à 52 doivent être possible
If nom = "" Then Exit Sub
rep = ActiveWorkbook.Path
If rep = "" Then rep = "C:\Users\Emmanuel\"
Direction = Dir(rep & "\*.xls")
nbfic = 0
While Direction > ""
nbfic = nbfic + 1
nom_fic(nbfic) = Direction
'MsgBox Nom_fic(nbfic) & " = " & nbfic
Direction = Dir()
Wend
'Stop
'Ouverture
For x = 1 To nbfic
fg = nom_fic(x)
If fg = "menu sem " & nom & ".xls" Then
'Stop
MsgBox ("Ce fichier existe déjà Veuillez modifier "): GoTo reprise
End If
Dim cpt As Integer
On Error Resume Next
Next
'Stop
ActiveWorkbook.SaveAs Filename:=rep & "menu sem " & nom & ".xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

' si le fichier existe déjà, j'ai un message d'erreur. comment faire pour avoir un retour au msgbox "choisir"
End If
End Sub

Re Résolu: Petit soucis pour sauvegarder sous

Chalet53,

Merci et encore Merci, c'est ce que je cherchais.
Encore un fois, je suis ébahit par le savoir faire des membres de ce site et je les en remercie.

Cordialement
Manu