Microsoft 365 Afficher msgbox et inputbox seulement 1x à l'ouverture du modèle

supercopain · 24 Mars 2022

Bonjour,
J'ai créer une feuille modèle qui à l'ouverture informe l'utilisateur sur quelques points
ensuite il y a quelques questions posées par des "InputBox" pour remplir des cellules
et ensuite le code propose l'enregistrement du fichier dans une répertoire à choisir (en maintenant les macros)

le problème : mon code ne fonctionne plus et je ne trouve pas le problème.

D'avance merci

supercopain · 25 Mars 2022

fanch55 à dit:

Pour vous faire avancer :

VB:

Option Explicit
Private Sub Workbook_Open()
Dim Titre$, Lignes$, Message$, Extent$
Dim Fso As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")
        Extent = UCase(Fso.GetExtensionName(ThisWorkbook.FullName))
    Set Fso = Nothing
    If Extent <> "XLSM" Then
        'dévérouille avant modification
        Sheets("INFO").Activate
            ActiveSheet.Unprotect "retd"
           
            Lignes = "Bonjour " & Environ("username") & vbLf '(& vblf = espace d'une ligne)
            Lignes = Lignes & "Nous sommes le " & Application.Proper(Format(Now, "dddd dd mmmm yyyy")) & " il est : " & Format(Now, "hh:mm:ss") & vbLf & vbLf
            Lignes = Lignes & "Lire attentivement les infos...

fanch55 · 17 Février 2023

Bonjour,
Regardez si ce code à placer dans le module ThisWorkBook peut vous convenir
( ne pas oublier de modifier le File dans la sub BeforeSave )

VB:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Not ThisWorkbook.Saved Then ThisWorkbook.Save
    Cancel = Not ThisWorkbook.Saved
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    File = [D3] & ", mesures " & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hh-mm") & ".xlsm"
    Fname = Application.GetSaveAsFilename(Title:="Enregistrement forcée du Classeur", _
            InitialFileName:=File, filefilter:="Xlsm Files (*.xlsm), *.xlsm")
    If Not Fname = False Then
        ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Else
        Cancel = True
    End If
End Sub

supercopain · 17 Février 2023

fanch55 à dit:

Bonjour,
Regardez si ce code à placer dans le module ThisWorkBook peut vous convenir
( ne pas oublier de modifier le File dans la sub BeforeSave )

VB:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Not ThisWorkbook.Saved Then ThisWorkbook.Save
    Cancel = Not ThisWorkbook.Saved
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    File = [D3] & ", mesures " & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hh-mm") & ".xlsm"
    Fname = Application.GetSaveAsFilename(Title:="Enregistrement forcée du Classeur", _
            InitialFileName:=File, filefilter:="Xlsm Files (*.xlsm), *.xlsm")
    If Not Fname = False Then
        ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Else
        Cancel = True
    End If
End Sub

Bonjour fanch55,

Merci pour votre proposition,
J'ai testé mais au moment ou je souhaite enregistrer il me bloque avec .."variable non définie" ?
j'ai peut-être oublié qq chose ...

fanch55 · 17 Février 2023

supercopain à dit:
Bonjour fanch55,

Merci pour votre proposition,
J'ai testé mais au moment ou je souhaite enregistrer il me bloque avec .."variable non définie" ?
j'ai peut-être oublié qq chose ...

Vous êtes surement en Option Explicit,
il faut déclarer les variables ...

VB:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Not ThisWorkbook.Saved Then ThisWorkbook.Save
    Cancel = Not ThisWorkbook.Saved
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim File as String
Dim Fname
    File = [D3] & ", mesures " & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hh-mm") & ".xlsm"
    Fname = Application.GetSaveAsFilename(Title:="Enregistrement forcée du Classeur", _
            InitialFileName:=File, filefilter:="Xlsm Files (*.xlsm), *.xlsm")
    If Not Fname = False Then
        ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Else
        Cancel = True
    End If
End Sub

Microsoft 365 Afficher msgbox et inputbox seulement 1x à l'ouverture du modèle

supercopain

XLDnaute Junior

supercopain

fanch55

XLDnaute Barbatruc

supercopain

XLDnaute Junior

fanch55

XLDnaute Barbatruc

Discussions similaires