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

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
supercopain

supercopain

XLDnaute Junior
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

supercopain

XLDnaute Junior
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
fanch55

fanch55

XLDnaute Barbatruc
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
supercopain

supercopain

XLDnaute Junior
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
fanch55

fanch55

XLDnaute Barbatruc
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
supercopain

supercopain

XLDnaute Junior
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
supercopain

supercopain

XLDnaute Junior
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

supercopain

XLDnaute Junior
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

Discussions similaires

D
  • Résolu(e)
XL 2021 afficher prénom de la plageprénom si correspondance avec prénom à la date du jour dans plage10 (fêtes)
Réponses
5
Affichages
430
DédéW83
D
B
  • Question
XL 2016 mes macros sont supprimées à l'ouverture de mes fichiers
Réponses
3
Affichages
478
TooFatBoy
TooFatBoy
G
  • Résolu(e)
XL 2019 [Résolu] VBA inputbox sélection d'une plage de cellulle
Réponses
2
Affichages
696
grodep
G
jeff1494
  • Question
XL 2021 Orientation d'une image dans le commentaire d'une cellule
2 3
Réponses
42
Affichages
2 K
AtTheOne
AtTheOne
L
  • Question
Microsoft 365 Code VBA pour commencer publipostage à partir d'un .dotx
Réponses
5
Affichages
1 K
Law0179
L
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
1 K
sousou
sousou
H
  • Résolu(e)
XL 2019 Action lors de la sélection d'une cellule ds une colonne
Réponses
3
Affichages
558
Hutchy33
H
F
  • Question
XL 2016 Blocage macro sur instruction SET
Réponses
6
Affichages
520
job75
job75
R
  • Résolu(e)
XL 2016 Horloge qui démarre automatiquement à l'ouverture du fichier.
2
Réponses
16
Affichages
2 K
TooFatBoy
TooFatBoy
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

Membres actuellement en ligne

4 membres et 68 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 655
Messages
2 111 605
Membres
111 217
dernier inscrit
aladinkabeya2