Petit soucis pour sauvegarder sous

  • Initiateur de la discussion Initiateur de la discussion Manporta
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

M

Manporta

Guest
Bonjour à tous,

Je cherche certainement mal, mais je n'arrive pas à trouver mon bonheur sur le forum.
dans mon input box je ne dois avoir que des chiffres de 01 à 52 et quand je sauvegarde avec un nom déjà existant, j'ai un message d'erreur. Comment faire pour limiter le nombre et revenir au msgbox "choisir"

en vous remerciant 😕
Manu

Sub sauver()

Dim reponse As String, nom As String
choisir = MsgBox("Voulez-vous enregistrer ce menu ?", vbYesNo)
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
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

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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
7
Affichages
661
Réponses
3
Affichages
879
Retour