Bonsoir
je cherche une macro pour le fichier excel en PJ,
l'utilisateur doit remplir les champs désignés, une fois rempli, la macro doit lui demander ou il doit enregistrer son fichier excel
bien sure, je veux que le nom du fichier soit le contenu de la cellule H8 qui doit être rempli par l'utilisateur
une fois enregistrer le fichier reste ouvert, si jamais une autre modification est a faire, le fichier s'enregistre avec les dernières modifications
je ne sais pas si ma demande est complexe, mais est ce que vous avez une idée?
votre support est appréciable, merci
aussi, si c'est possible, à l'ouverture du fichier, la marco montre à l'utilisateur les champs à remplir en commencant par le champ H8 qui sera à la fin le nom du fichier
merci
La feuille est protégée par mot de passe, comment modifier la cellule H8 ?
Et êtes-vous sûr qu'il s'agit de H8 car elle contient le texte "FRAIS SPOT NBR JOUR" ???
Essayez cette macro mais sur MAC pas du tout certain que Application.GetSaveAsFilename fonctionne :
VB:
Sub Enregistrer()
Dim fichier As Variant
fichier = Sheets("CALCUL").[H8]
ChDir ThisWorkbook.Path
fichier = Application.GetSaveAsFilename(fichier, "Excel Files (*.xlsm), *.xlsm")
Application.DisplayAlerts = False
If fichier <> False Then ThisWorkbook.SaveAs fichier
End Sub
Pour infos
La feuille est protégée mais sans mot de passe.
(J'ai fait: Ôter la protection de la feuille et pas de prompt pour un mot de passe)
Et non, ne fonctionnera pas sur Mac
Actuellement sous XL2K3, j'ai donc du convertir le *.xlsm en *.xls
Je suis étonné que cette conversion* supprime le mot de passe.
???
*: réalisée avec le pack de compatibilité pour Microsoft Office 2000, Office XP ou Office 2003 mis à disposition par Microsoft et que j'avais téléchargé à l'époque sur ce PC.
Sub Enregistrer()
Dim fichier As Variant
fichier = Sheets("CALCUL").[H8] 'nom sans extension
ChDir ThisWorkbook.Path
fichier = Application.GetSaveAsFilename(fichier)
If fichier <> False Then ThisWorkbook.SaveAs fichier & ".xlsm"
End Sub
Je m'étais arrêté à cette partie de l'article de Ron de Bruin
There are a few nice parameters that you can use with GetSaveAsFileName that all work OK in Windows but not on a Mac.
Filefilter is a very important one that is not working on a Mac.
Sub Enregistrer2()
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "DOSSIER D'ENREGISTREMENT"
If Not .Show Then Exit Sub
ThisWorkbook.SaveAs .SelectedItems(1) & Application.PathSeparator & Sheets("CALCUL").[H8], FileFormat:=52
End With
End Sub
La feuille est protégée par mot de passe, comment modifier la cellule H8 ?
Et êtes-vous sûr qu'il s'agit de H8 car elle contient le texte "FRAIS SPOT NBR JOUR" ???
Essayez cette macro mais sur MAC pas du tout certain que Application.GetSaveAsFilename fonctionne :
VB:
Sub Enregistrer()
Dim fichier As Variant
fichier = Sheets("CALCUL").[H8]
ChDir ThisWorkbook.Path
fichier = Application.GetSaveAsFilename(fichier, "Excel Files (*.xlsm), *.xlsm")
Application.DisplayAlerts = False
If fichier <> False Then ThisWorkbook.SaveAs fichier
End Sub
merci pour ces reponses, mais effectivement c'est de prendre en charge ce qui est ecrit dans la cellule H1 et non pas H8 (erreur de ma part)
pour ce qui est des protection, effectivement j'ai envoyer la version proteger (erreur aussi de ma part) mais apres lecture, je vois que la protection a ete oter, donc par de probleme dans ce cas
pour ce qui est de la macro
est ce que c'est la derniere version qu'il faut prendre ou non ?
Voyez le fichier joint et cette macro dans le code de la feuille CALCUL (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim fichier As Variant
With [H1]
If LCase(.Value) & ".xlsm" = LCase(ThisWorkbook.Name) Then Exit Sub
If .Value = "" Then .Value = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5): Exit Sub
ChDir ThisWorkbook.Path
fichier = Application.GetSaveAsFilename(.Value)
If fichier = False Then .Value = "": Exit Sub
fichier = Left(fichier, InStrRev(fichier, Application.PathSeparator)) & .Value & ".xlsm"
End With
Application.DisplayAlerts = False 'si le fichier existe déjà
ThisWorkbook.SaveAs fichier
End Sub