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

Créer une discussion
Répondre

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 !

S'inscrire
supercopain

supercopain

XLDnaute Junior
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
 
Solution
supercopain
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...
Cliquez pour agrandir...
Trier par date Trier par votes
oup's...
voilà le code qui se trouve dans "ThisWorkbook"


1 ouverture du classeur cellule "D3" vide alors on lance le code
2 l'utilisateur enregistre son classeur sous ...
3 lors de la ré-ouverture du classeur enregistré par l'utilisateur le code ne se lance pas car D3 contient le numéro d'essai

...et là le code se lance à chaque fois !
pourquoi???


Private Sub Workbook_Open()
On Error GoTo fin
Application.ScreenUpdating = False
Dim Titre$, Lignes$, Message$, i&
If Feuil24.[D3] = "" Then 'ou bien 0
Titre = "INFORMATION"

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 suivantes... " & vbLf
Lignes = Lignes & "Indique le numéro d'essai, le numéro de projet, sélectionne le répertoire et valide!" & vbLf & vbLf
Lignes = Lignes & "La version du fichier utilisé est " & ThisWorkbook.Name & vbLf & vbLf
Lignes = Lignes & "Si tu rencontre des difficultés appel à l'aide!" & vbLf & vbLf
Lignes = Lignes & "Maintenant, tu peux cliquer sur OK !"


Message = Lignes
MsgBox Message, 6, Titre ' ou ' For i = 1 To 6 'MsgBox Message, i, Titre 'Next i
Feuil24.[D3] = Feuil24.[D3] + 1
End If

If Sheets("Feuil24").Range("D3") = "" Then Exit Sub

'dévérouille avant modification
Sheets("INFO").Unprotect "retd"

'Aprés validation inputBox ....
'Enregistrement du fichier mesure sous ...
Dim objSaveBox As FileDialog

essai = InputBox("Numéro de l'essai ?", "Essai no", "EXXXX")
Range("D3") = essai

projet = InputBox("Numéro du projet ?", "Projet no", "CHDXXX...CHSXXXX..")
Range("D5") = projet

Vf = InputBox("Essai avec un Variateur de fréquence ?", "Répondre par oui ou non")
Range("G5") = UCase(Vf)

booster = InputBox("Essai avec un BOOSTER ?", "Répondre par oui ou non")
Range("G7") = UCase(booster)

'***************************************************************************
'masquer les lignes concernant BOOSTER

Sheets("INFO").Activate
''Rows("72:131,154:173").EntireRow.Hidden = True
Rows("1:230").EntireRow.Hidden = False

If Range("g7").Value = "NON" Then Range("72:131, 153:173").EntireRow.Hidden = True
'If Range("i5").Value = "Non" Then Rows("72:131,153:173").EntireRow.Hidden = False

If Range("g5").Value = "NON" Then Range("58:70").EntireRow.Hidden = True

'Login (D7)de la personne qui créer la nouvelle config
Sheets("INFO").Range("D7") = Environ("Username")

Range("G3") = Format(ActiveWorkbook.BuiltinDocumentProperties(12), "dd mmmm yyyy")

''Définit la fenêtre "Enregistrer sous"
Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)

With objSaveBox
'Définit un nom par défaut dans le champ "Nom de fichier".
.InitialFileName = essai & ", mesures " & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hh-mm") & ".xlsx"

'Définit le type de fichier par défaut :
'(la valeur 4 Permet de spécifier les classeurs "Excel 97-2003" lorsque vous êtes dans Excel 2007)
.FilterIndex = 2

'Affiche la boîte de dialogue
.Show
'Enregistre
.Execute
End With

'verouiller aprés modification
Sheets("INFO").Protect "retd"

Application.ScreenUpdating = True
fin:
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
supercopain à dit:
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
Cliquez pour agrandir...
Bonjour,
Est-ce qu'il y a un moyen pour éviter le lancement du code une fois que le nom du classeur à changer?
 
Vote positif 0 Vote négatif
A l'analyse du Code fourni :
  1. Si D3 ="" alors valoriser D3
  2. Si D3 = "" alors sortie du code
  3. Sauvegarde

Le point 2 ne se fera jamais
Le point 3 se fera toujours

Que voulez-vous faire exactement ?
Sauvegarder immédiatement le fichier sous un nom conventionné avec l'extension Xlsm à l'ouverture du Xltm ?
 
Vote positif 0 Vote négatif
fanch55 à dit:
A l'analyse du Code fourni :
  1. Si D3 ="" alors valoriser D3
  2. Si D3 = "" alors sortie du code
  3. Sauvegarde

Le point 2 ne se fera jamais
Le point 3 se fera toujours

Que voulez-vous faire exactement ?
Sauvegarder immédiatement le fichier sous un nom conventionné avec l'extension Xlsm à l'ouverture du Xltm ?
Cliquez pour agrandir...
Je m'excuse j'ai du mal a expliquer mon souci...

Mon problème :
Après avoir fait un double clic sur mon fichier modèle (.xltm)
un msgbox s'affiche et indique plusieurs infos -> clic Ok
une Inputbox demande à entrer un numéro d'essai
une deuxième demande un numéro de projet
une troisième....
une quatrième.....
Après avoir renseigné les différentes "InputBox" ->
proposition d'enregistrer le fichier "sous" avec un nom prédéfini et une incrémentation avec la date-heure (au format .xlsm)

MAis seulement quand on ré-ouvre ce fichier il re-propose de remplir une inputbox avec numéro d'essai et ensuite le projet et ensuite .....

Au début de mon projet ça fonctionnais, mais après plusieurs adaptation/modification maintenant ça plante, et recommence à s'afficher à chaque réouverture du fichier
Comment évitez cela ?
 
Dernière édition:
Vote positif 0 Vote négatif
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 suivantes... " & vbLf
            Lignes = Lignes & "Indique le numéro d'essai, le numéro de projet, sélectionne le répertoire et valide!" & vbLf & vbLf
            Lignes = Lignes & "La version du fichier utilisé est " & ThisWorkbook.Name & vbLf & vbLf
            Lignes = Lignes & "Si tu rencontre des difficultés appel à l'aide!" & vbLf & vbLf
            Lignes = Lignes & "Maintenant, tu peux cliquer sur OK !"
            
            MsgBox Lignes, vbInformation, "INFORMATION"
                        
            Do: [D3] = InputBox("Numéro de l'essai ?", "Essai no", "EXXXX"): Loop While [D3] = ""
            
            Do: [D5] = InputBox("Numéro du projet ?", "Projet no", "CHDXXX...CHSXXXX.."): Loop While [D5] = ""
            
            [G5] = IIf(MsgBox("Essai avec un Variateur de fréquence ?", vbQuestion + vbYesNo) = vbYes, "OUI", "NON")
            [G7] = IIf(MsgBox("Essai avec un BOOSTER ?", vbQuestion + vbYesNo) = vbYes, "OUI", "NON")
            
            '***************************************************************************
            'masquer les lignes concernant BOOSTER
            
            ''Rows("72:131,154:173").EntireRow.Hidden = True
            Rows("1:230").EntireRow.Hidden = False
            
            If [G7] = "NON" Then Range("72:131, 153:173").EntireRow.Hidden = True
            'If Range("i5").Value = "Non" Then Rows("72:131,153:173").EntireRow.Hidden = False
            
            If [G5] = "NON" Then Range("58:70").EntireRow.Hidden = True
            
            'Login (D7)de la personne qui créer la nouvelle config
            [D7] = Environ("Username")
            
            [G3] = Format(ActiveWorkbook.BuiltinDocumentProperties(12), "dd mmmm yyyy")
            
            'verouiller aprés modification
            ActiveSheet.Protect "retd"
          
            With Application.FileDialog(msoFileDialogSaveAs)
                'Définit un nom par défaut dans le champ "Nom de fichier".
                .InitialFileName = [D3] & ", mesures " & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hh-mm") & ".xlsm"
                .FilterIndex = 2 ' xlsm
                'Affiche la boîte de dialogue
                .Show
                'Enregistre
                .Execute
            End With
        
    End If
    
End Sub
 
Vote positif 0 Vote négatif
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 suivantes... " & vbLf
            Lignes = Lignes & "Indique le numéro d'essai, le numéro de projet, sélectionne le répertoire et valide!" & vbLf & vbLf
            Lignes = Lignes & "La version du fichier utilisé est " & ThisWorkbook.Name & vbLf & vbLf
            Lignes = Lignes & "Si tu rencontre des difficultés appel à l'aide!" & vbLf & vbLf
            Lignes = Lignes & "Maintenant, tu peux cliquer sur OK !"
           
            MsgBox Lignes, vbInformation, "INFORMATION"
                       
            Do: [D3] = InputBox("Numéro de l'essai ?", "Essai no", "EXXXX"): Loop While [D3] = ""
           
            Do: [D5] = InputBox("Numéro du projet ?", "Projet no", "CHDXXX...CHSXXXX.."): Loop While [D5] = ""
           
            [G5] = IIf(MsgBox("Essai avec un Variateur de fréquence ?", vbQuestion + vbYesNo) = vbYes, "OUI", "NON")
            [G7] = IIf(MsgBox("Essai avec un BOOSTER ?", vbQuestion + vbYesNo) = vbYes, "OUI", "NON")
           
            '***************************************************************************
            'masquer les lignes concernant BOOSTER
           
            ''Rows("72:131,154:173").EntireRow.Hidden = True
            Rows("1:230").EntireRow.Hidden = False
           
            If [G7] = "NON" Then Range("72:131, 153:173").EntireRow.Hidden = True
            'If Range("i5").Value = "Non" Then Rows("72:131,153:173").EntireRow.Hidden = False
           
            If [G5] = "NON" Then Range("58:70").EntireRow.Hidden = True
           
            'Login (D7)de la personne qui créer la nouvelle config
            [D7] = Environ("Username")
           
            [G3] = Format(ActiveWorkbook.BuiltinDocumentProperties(12), "dd mmmm yyyy")
           
            'verouiller aprés modification
            ActiveSheet.Protect "retd"
         
            With Application.FileDialog(msoFileDialogSaveAs)
                'Définit un nom par défaut dans le champ "Nom de fichier".
                .InitialFileName = [D3] & ", mesures " & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hh-mm") & ".xlsm"
                .FilterIndex = 2 ' xlsm
                'Affiche la boîte de dialogue
                .Show
                'Enregistre
                .Execute
            End With
       
    End If
   
End Sub
Cliquez pour agrandir...
Alors c'est exactement ça ! ça marche nickel !!
Et ces deux boites qui évite d'indiquer autre chose que "OUI" ou "NON" c'est parfait.
Merci mille fois fanch55 je fini la semaine en beauté !!
Bon week-end
 
Vote positif 0 Vote négatif
Solution
Bonjour,
Je reviens sur cette solution de code VBA qui fonctionne toujours parfaitement,
par-contre est-ce qu'on peut partir de ça pour créer une nouvelle ??

ce que je cherche au final c'est quand les utilisateurs souhaitent enregistrer leur fichier (qui est au format .xltm à l'ouverture)
Il faut qu'à la fermeture de ce fichier il s'affiche la boîte de dialogue "enregistrer sous" pour proposer un enregistrement (dans un dossier spécifique et au format .xlsm


D'avance je vous remercie
 
Vote positif 0 Vote négatif
supercopain à dit:
Bonjour,
Je reviens sur cette solution de code VBA qui fonctionne toujours parfaitement,
par-contre est-ce qu'on peut partir de ça pour créer une nouvelle ??

ce que je cherche au final c'est quand les utilisateurs souhaitent enregistrer leur fichier (qui est au format .xltm à l'ouverture)
Il faut qu'à la fermeture de ce fichier il s'affiche la boîte de dialogue "enregistrer sous" pour proposer un enregistrement (dans un dossier spécifique et au format .xlsm


D'avance je vous remercie
Cliquez pour agrandir...
..ou peut-être qu'il existe plus simple pour réaliser ça ???
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

Discussions similaires

N
  • Résolu(e)
Microsoft 365 Afficher-désafficher lignes selon réponses de menu déroulants (oui-non)
Réponses
11
Affichages
479
NicodePorto
N
B
  • Question Question
XL 2016 Exécution macro à l'ouverture de fichier
Réponses
3
Affichages
630
crocrocro
C
M
  • Question Question
Microsoft 365 Utilisation du ficher Excel à plusieurs utilisateurs en simultané.
Réponses
5
Affichages
482
TooFatBoy
TooFatBoy
G
  • Résolu(e)
XL 2019 [Résolu] VBA inputbox sélection d'une plage de cellulle
Réponses
2
Affichages
802
grodep
G
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
528
arnoldbrice19
A
D
  • Résolu(e)
Microsoft 365 Problème interférences entre macros
Réponses
14
Affichages
148
Phil69970
Phil69970
S
  • Résolu(e)
Microsoft 365 Mailing mise en forme HTML : revenir à la ligne automatique si trop de texte saisie
2
Réponses
17
Affichages
200
spike29
S
jeff1494
  • Question Question
XL 2021 Orientation d'une image dans le commentaire d'une cellule
2 3
Réponses
42
Affichages
2 K
AtTheOne
AtTheOne
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
125
JJ69
J
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
445
loreak
L
H
  • Résolu(e)
XL 2019 Action lors de la sélection d'une cellule ds une colonne
Réponses
3
Affichages
592
Hutchy33
H
F
  • Question Question
XL 2016 Blocage macro sur instruction SET
Réponses
6
Affichages
579
job75
job75
M
  • Résolu(e)
Microsoft 365 enregistrement copie du classeur ouvert avec mot de passe et incrémentation
2
Réponses
27
Affichages
1 K
meyscal
M
A
  • Résolu(e)
XL 2016 Affichage plage à l'ouverture du fichier
Réponses
3
Affichages
743
AxelViens
A
G
  • Résolu(e)
Microsoft 365 Faire une collection de collection en VBA
2
Réponses
25
Affichages
2 K
dysorthographie
dysorthographie
K
  • Question Question
Microsoft 365 Comment afficher des infos d'un fichier ouvert avec "GetOpenFileName"
Réponses
11
Affichages
689
fanch55
fanch55
C
  • Question Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
427
CathyLD
C
Y
  • Résolu(e)
Microsoft 365 Fermeture d'un Fichier Excel si celui-ci est déjà ouvert
Réponses
12
Affichages
1 K
Yoyo60
Y
F
  • Question Question
XL 2016 Arrêt macro intempestif
Réponses
3
Affichages
1 K
flyingmuad
F
T
  • Résolu(e)
Microsoft 365 Conditionner l'accès à une page d'un multipage
2
Réponses
26
Affichages
2 K
TooFatBoy
TooFatBoy
Retour