1ère macro oui oui !!!

[JC de Lorient]

bsr le forum

je viens de me lancer dans ma 1ère macro et bien évidemment elle fonctionne pas !!!!

pourtant elle est toute simple du moins je pensais !!

donc voilà :
j'ouvre mon classeur, la page menu s'affiche ça c ok

ensuite je voudrais mas text box pour le mot de passe

si mot de passe bon on continue sinon on ferme le classeur

voilà mon code :

Private Sub Workbook_Open()

Sheets('Menu').Activate

Dim mdp As String

mdp = InputBox('Mot de passe?', 'Merci d'entrer le mot de passe')
If mdp <> '****' Then Woorkbooks('JOEL.XLS').Close

End Sub


qu'est ce qui bloque ?

merci a vous !

JC

 

[selecteur]

Private Sub Workbook_Open()

Dim mdp As String

mdp = InputBox('Mot de passe?', 'Merci d'entrer le mot de passe')
If mdp <> '1234' Then
mdp = InputBox('Deuxième essai !', 'Merci d'entrer le mot de passe')
If mdp <> '1234' Then
MsgBox 'Au revoir.', 0, 'Pas de chance'ThisWorkbook.Saved = True
Workbooks('JOEL.xls').Close
Exit Sub
Else
Sheets('Menu').Activate
End If
End If

End Sub

 

[selecteur]

erreur d'inattention : saut de ligne après le msgbox bien s&ucirc;r

 

[JC de Lorient]

re tout le monde

put... de ,0, !!!!!!!

g cherché, essayé et c aussi simple que ça !!!!

encore merci !!

JC

 

[ChTi160]

Salut'JC Oupssss Bonjour à tous!!!!!!!!!!!!!!!!!!
si tu regardes l'aide au Sujet de MsgBox tu verras qu'il est possible de changer le titre
MsgBox(prompt[, buttons] [, title] [, helpfile, context])
Amicalement
Jean marie

Message édité par: ChTi160, à: 09/04/2005 14:39

 

[JC de Lorient]

re tout le monde

encore des questions et je trouve pas la soluce
j'ai 2 codes
1er :
Sub mdp()
Dim essaiMdp, mdp As String
Dim essai As Integer
essai = 1
mdp = '1234'

While essai <= 3

essaiMdp = InputBox('Code entrée programme ?')
If essaiMdp = mdp Then
flag = True
essai = 4
Else
essai = essai + 1
flag = False

End If

Wend

If flag = True Then
Sheets('Menu').Activate
Else
MsgBox 'Au revoir.', 0, 'Consultez l'administrateur'
ThisWorkbook.Saved = True
Workbooks('JOEL.xls').Close
End If

End Sub


le 2ème
Private Sub Workbook_Open()
Dim mdp As String

mdp = InputBox('Code d'entrée ?', 'Merci d'entrer le mot de passe')
If mdp <> '1234' Then
mdp = InputBox('Deuxième essai !', 'Merci d'entrer le mot de passe')
If mdp <> '1234' Then
MsgBox 'Au revoir.', 0, 'Consultez l'administrateur !'
ThisWorkbook.Saved = True
Workbooks('JOEL.xls').Close
Exit Sub
Else
Sheets('Menu').Activate
End If
End If

End Sub

le 1er active très bien la feuille 'Menu' mais pas le 2ème !!

ou est l'erreur ?

merci a vous une nouvelle fois
JC

 

[dg62]

re

problème des si (IF) imbriqués

il faut mettre end if et end sub

Sheets('Menu').Activate

une 2e fois.

 

[ChTi160]

re
j'ai modifié de la sorte

Private Sub Workbook_Open()
Dim mdp As String, mdp2 As String

mdp = InputBox('Code d'entrée ?', 'Merci d'entrer le mot de passe')
If mdp = '1234' Then

Sheets('Menu').Activate
Else
mdp2 = InputBox('Deuxième essai !', 'Merci d'entrer le mot de passe')

If mdp2 <> '1234' Then
MsgBox 'Au revoir.', 0, 'Consultez l'administrateur !'
ThisWorkbook.Saved = True
Workbooks('Classeur1.xls').Close
Else
Sheets('Menu').Activate
End If
End If

End Sub

Amicalement
Jean Marie

Message édité par: ChTi160, à: 09/04/2005 15:17

Message édité par: ChTi160, à: 09/04/2005 15:32

 

[dg62]

Bonjour Selecteur


a propos de ton code, tu multiplies les IF imbriqués et à la fin c'est difficile de s'y retrouver. Bon c'est vrai, là il n'y en a que deux.

Les boucles while wend, do while... sont faites pour éviter ce genre de problème.

De plus le code est beaucoup plus lisible.

Message édité par: dg62, à: 09/04/2005 15:19

 

[JC de Lorient]

re....

je vous remercie tous les deux
ça fonctionne a merveille

une dernière petite chose : c pas hyper important ça serait juste un petit mieux!
g ce code

Private Sub CommandButton1_Click()
Dim TheSheetName As String

TheSheetName = InputBox('NOUVELLE SAISON sous la forme aaaa ex: 2005 ', 'Nouvelle Saison')
If TheSheetName = '' Then Exit Sub

Worksheets('Matrice').Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = TheSheetName
End Sub

quel code peut on rajouter pour avoir un message d'erreur si la feuille existe déjà ?

merci bcp et très bon samedi

JC

 

[dg62]

re

Private Sub CommandButton1_Click()
Dim TheSheetName As String
Dim Sfeuil As String

TheSheetName = InputBox('NOUVELLE SAISON sous la forme aaaa ex: 2005 ', 'Nouvelle Saison'Â'Â'Â'Â')
If TheSheetName = '' Then Exit Sub
   For Each feuil In Worksheets
          Sfeuil = LCase(Worksheets(feuil.Index).Name)
          
       If TheSheetName = Sfeuil Then

          MsgBox ('la feuille existe déjà'Â'Â'Â'Â')
            Exit Sub
       Else
          Worksheets('Matrice'Â'Â'Â'Â').Copy After:=Worksheets(Worksheets.Count)
          Worksheets(Worksheets.Count).Name = TheSheetName
       End If
   Next
End Sub

Message édité par: dg62, à: 09/04/2005 15:51

Message édité par: dg62, à: 09/04/2005 15:53

Message édité par: dg62, à: 09/04/2005 15:55

 

[dg62]

re

à l'apercu du code je vois :

& nbsp;If TheSheetName = Sfeuil Then

il faut supprimer & npsp;

 

[dg62]

re

Il y avait un petit bug

Private Sub CommandButton1_Click()
Dim TheSheetName As String
Dim Sfeuil As String

TheSheetName = InputBox('NOUVELLE SAISON sous la forme aaaa ex: 2005 ', 'Nouvelle Saison')
If TheSheetName = '' Then Exit Sub
   For Each feuil In Worksheets
          Sfeuil = LCase(Worksheets(feuil.Index).Name)
          
       If TheSheetName = Sfeuil Then

          MsgBox ('la feuille existe déjà')
            Exit Sub
       Else
          Worksheets('Matrice').Copy after:=Worksheets(Worksheets.Count)
          Worksheets('Matrice (2)').Name = TheSheetName
          Exit Sub
       End If
    Next
End Sub

 

[ChTi160]

re 'JC, dg62
une autre approche
Private Sub CommandButton1_Click ()

Dim NomFeuille As String
Dim WS As Worksheet

NomFeuille = InputBox ('NOUVELLE SAISON sous la forme aaaa ex: 2005', 'Nouvelle Saison Â'Â'')

If NomFeuille = '' Then
MsgBox 'Veuillez entrer un nom valide ', vbCritical, 'Attention'
Exit Sub
End If

For Each WS In Worksheets
If LCase (WS.Name) = LCase (NomFeuille) Then
MsgBox 'La feuille ' & NomFeuille & ' existe déjà', vbCritical, 'Attention'
Exit Sub
End If
Next WS
Worksheets ('Matrice').Copy After: =Worksheets( Worksheets.Count)
Worksheets (Worksheets.Count).Name = NomFeuille

Sheets (1).Activate

End Sub
Amicalement
Jean Marie

Message édité par: ChTi160, à: 09/04/2005 16:32

 

[JC de Lorient]

re le forum

merci a tous les deux

DG, g essayé ton code (le2ème) mé y un souci quand on veut créer une feuille déjà existante

Chti, ton code fonctionne très bien !

mille merci je ne pensais pas que ma 1ère demande aille aussi loin

très bon week end a tous

JC

 

[dg62]

re JC, Chti160

et voilà le code corrigé. En esperant que tout cela te serve.

Private Sub CommandButton1_Click()
Dim TheSheetName As String
Dim Sfeuil As String

TheSheetName = InputBox('NOUVELLE SAISON sous la forme aaaa ex: 2005 ', 'Nouvelle Saison'Â'Â')
If TheSheetName = '' Then Exit Sub
   For Each feuil In Worksheets
          Sfeuil = LCase(Worksheets(feuil.Index).Name)
          
        If TheSheetName = Sfeuil Then
            MsgBox ('la feuille existe déjà'Â'Â')
            Exit Sub
        Else
          flag = False
        End If
    Next
          If flag = False Then
           Worksheets('Matrice'Â'Â').Copy after:=Worksheets(Worksheets.Count)
           Worksheets('Matrice (2)'Â'Â').Name = TheSheetName
          End If
    
End Sub

c'est vrai que le flag ne sert à rien dans ce cas

Message édité par: dg62, à: 09/04/2005 18:03