Problème menu bouton d'une forme

Résolu
Signaler
Messages postés
40
Date d'inscription
vendredi 4 avril 2008
Statut
Membre
Dernière intervention
12 septembre 2012
-
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
-
Bonjour,

Je vous explique, je sais pas ce que j'ai fait mais quand je lance mon appli en VB6, les boutons, les frames et le menu de ma forme n'"existe" plus.
Ma forme s'appelle Principal et qaund j'écrit Principal. dans la forme normalement j'ai accès à tous les boutons et autres controls, donc je suis sensé pouvoir écrire Principal.bouton41.Visible = True mais là plus possible il ne connait plus le bouton.

Aidez moi please.

18 réponses

Messages postés
682
Date d'inscription
vendredi 6 avril 2007
Statut
Membre
Dernière intervention
4 août 2012
6
Private Sub Boutoneleve1_Click()
Dim Wrd As Object
Dim wbExcel As Object
Dim wsExcel As Object

Set Wrd = CreateObject("Excel.Application")
Set wbExcel = Wrd.Workbooks.Open(CommonDialog1.FileName)
Set wsExcel = wbExcel.Worksheets("Liste des sections")

Wrd.DisplayAlerts = False

If wsExcel.Cells(4, 27) = "NEWELEVE" Then

       wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
    NouvEnregEleve
ElseIf  wsExcel.Cells(4, 27) = "MODIFSECTION" Then

         wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
    ModificationSection

ElseIf wsExcel.Cells(4, 27) = "MODIFELEVE" Then

         wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
    ModificationFicheEleve

End if

Wrd.Save

Wrd.Workbooks.Close


End Sub

ceci est juste pour te montrer comment déja faire moins lourd

je n'ai pas corrigé un bouton complet mais seulement  les trois premieres conditions te laissant le soin de faire le reste


on pourrait le faire aussi comme suit

Private Sub Boutoneleve1_Click()
Dim Wrd As Object
Dim wbExcel As Object
Dim wsExcel As Object

Set Wrd = CreateObject("Excel.Application")
Set wbExcel = Wrd.Workbooks.Open(CommonDialog1.FileName)
Set wsExcel = wbExcel.Worksheets("Liste des sections")

Wrd.DisplayAlerts = False


Select Case wsExcel.Cells(4, 27)

    Case "NEWELEVE"

       wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value

       NouvEnregEleve

    Case "MODIFSECTION"

         wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value

        ModificationSection

    Case "MODIFELEVE"

         wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value

        ModificationFicheEleve

End Select
Wrd.Save

Wrd.Workbooks.Close



End Sub
[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
euh..... et tu arrives à te relire dans tout çà ?

déjà si tu as cette tonne * 72, on peut supposer que tu as trop de lignes pour une feuille....

il faut essayer de factoriser, gagner quelques lignes, surtout pour la lisibilité. remet le nez dans ton code dans un an, j'te mets au défit de le débugger...

ensuite en VB6 tu as les groupes de contrôles, ce qui permettra de ne pas avoir 72* le même code.
à toi de voir, je n'ai pas regardé les similitudes entre boutin1 et bouton2

voici, pour bouton1, unemanière un peu plus claire de procéder :

Private Sub Boutoneleve1_Click()

Dim Wrd As Object
Dim wbExcel As Object
Dim wsExcel As Object
Dim nomfeuille As String

Set Wrd = CreateObject("Excel.Application")
Set wbExcel = Wrd.Workbooks.Open(CommonDialog1.FileName)
Set wsExcel = wbExcel.Worksheets("Liste des
sections")

nomfeuille = wsExcel.Cells(2, 27).Value

    Select Case wsExcel.Cells(4, 27)
    
    
        Case "NEWELEVE"
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                NouvEnregEleve

        Case "MODIFSECTION:"
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                ModificationSection

        Case "MODIFELEVE":
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                ModificationFicheEleve

        Case "SUPSECTION":
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                SupprimerSection

        Case "DESISTELEVE":
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                DesistementEleve

        Case "MODIFPROF":
                wsExcel.Cells(2, 28) = wbExcel.Worksheets("Professeurs").Cells(2, 2).Value
                wsExcel.Cells(2, 29) = wbExcel.Worksheets("Professeurs").Cells(2, 3).Value
                wsExcel.Cells(2, 30) = wbExcel.Worksheets("Professeurs").Cells(2, 4).Value
                SaveWRD Wrd
                ModificationProfesseur

        Case "DESISTPROF":
                wsExcel.Cells(2, 28) = wbExcel.Worksheets("Professeurs").Cells(2, 2).Value
                wsExcel.Cells(2, 29) = wbExcel.Worksheets("Professeurs").Cells(2, 3).Value
                wsExcel.Cells(2, 30) = wbExcel.Worksheets("Professeurs").Cells(2, 4).Value
                SaveWRD Wrd
                DesistementProfesseur

        Case "MODIFNOTES":
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                ModificationNotes

        Case "MODIFPLANINGSECTION":
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                ModificationPlaningSection

        Case "MODIFPLANINGSALLE":
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                ModificationPlaningSalle

        Case "MODFIELEVE":
                wsExcel.Cells(2, 28) = wbExcel.Worksheets(nomfeuille).Cells(2, 2).Value
                wsExcel.Cells(2, 29) = wbExcel.Worksheets(nomfeuille).Cells(2, 3).Value
                wsExcel.Cells(2, 30) = wbExcel.Worksheets(nomfeuille).Cells(2, 4).Value
                SaveWRD Wrd
                ModFiEleve

        Case "DESELEVE":
                wsExcel.Cells(2, 28) = wbExcel.Worksheets(nomfeuille).Cells(2, 2).Value
                wsExcel.Cells(2, 29) = wbExcel.Worksheets(nomfeuille).Cells(2, 3).Value
                wsExcel.Cells(2, 30) = wbExcel.Worksheets(nomfeuille).Cells(2, 4).Value
                SaveWRD Wrd
                Deseleve

        Case "LISTESECTION":
                wsExcel.Cells(15, 49) = wsExcel.Cells(15, 49) +
1
                wsExcel.Cells(15, (49 + wsExcel.Cells(15, 49))) =
wsExcel.Cells(1,
1).Value
                SaveWRD Wrd
                ListeEleveSection
    

        Case "LISTEIMP":
                SaveWRD Wrd
                ImpressionPDF
    

        Case "CREERFICHIEREXCEL":
                wsExcel.Cells(2, 28) = wbExcel.Worksheets("Professeurs").Cells(2, 2).Value
                wsExcel.Cells(2, 29) = wbExcel.Worksheets("Professeurs").Cells(2, 3).Value
                SaveWRD Wrd
                CREERFICHIEREXCEL

        Case "BULLETINSECTION":
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                BulletinSection

        Case "BULLELEVESECT":
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1).Value
                SaveWRD Wrd
                bullelevesect

        Case "BULLELEVE":
                wsExcel.Cells(2, 28) = wbExcel.Worksheets(nomfeuille).Cells(2, 2).Value
                wsExcel.Cells(2, 29) = wbExcel.Worksheets(nomfeuille).Cells(2, 3).Value
                wsExcel.Cells(2, 30) = wbExcel.Worksheets(nomfeuille).Cells(2, 4).Value
                SaveWRD Wrd
                Bulleleve

    End Select

Set wsExcel = Nothing
Set wbExcel = Nothing
Set Wrd = Nothing
End Sub

bon courage
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
1) constante public, sauf comme le dit pile_poil si la valeur change, dans quel cas variable public qu'il faut, un moment, initialiser....
tout çà se fait dans un module à rajouter
plus d'infos :
Q : [doc/faq.aspx#vb_varpublic Code : Comment conserver le contenu d'une
variable entre différents formulaires]

2) tu ne peux pas, pas la place d'afficher....

<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
tu m'as induit en erreur dans l'ordre des question pile_poil ^^
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
Private Sub SaveWRD(ByRef oWrd As Object)


oWrd est de type OBJECT

Dim Wrd, wbExcel, wsExcel As Object
tu n'as pas typé Wrd et wbExcel, ils sont donc de type VARIANT

or comme c'est un argument BYREF qui est attendu, les types doivent impérativement être les mêmes....

Dim Wrd as Object, wbExcel as Object, wsExcel As Object
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
salut,
tu parles uniquement de l'intellisense donc?...

plusieurs possibilités...
un usercontrol actif en mode édition, genre avec un timer...
un usercontrol mal codé, en mode édition, ouvert en même temps que ta fenêtre de code
un objet (usercontrol ou class) avec une erreur de code, genre :

private property get machin as string
end property
private property let machin(truc as pas_string)
end property

ou simplement 2 fonctions public portant le même nom dans le même module

et il doit bien encore y avoir une centaine de raisons possibles...
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
Messages postés
40
Date d'inscription
vendredi 4 avril 2008
Statut
Membre
Dernière intervention
12 septembre 2012

bon alors je vais la refaire et copier les codes dans la nouvelle forme.

mais de ce fait je me permet de vous poser une autre question voila, comme je suis débutant, j'ai mis 75 boutons sur la forme.

Je vous met le code des boutons 1 et 2 sachant que le reste est identique:
Je pense qu'il doit être possible de modifier pour créer les boutons avec add et faire un seul code style boutonelevei_click

je sais c'est lourd, mais je débute ...

Private Sub Boutoneleve1_Click()


Dim Wrd As Object
Dim wbExcel As Object
Dim wsExcel As Object
Dim NomMacro, nomfeuille As String


Set Wrd = CreateObject("Excel.Application")
Set wbExcel = Wrd.Workbooks.Open(CommonDialog1.FileName)
Set wsExcel = wbExcel.Worksheets("Liste des sections")


nomfeuille = wsExcel.Cells(2, 27).Value


If wsExcel.Cells(4, 27) "NEWELEVE" Then NomMacro "NEWELEVE"If NomMacro "NEWELEVE" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "NEWELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "NEWELEVE" Then Wrd.Save
If NomMacro = "NEWELEVE" Then Wrd.Workbooks.Close
If NomMacro = "NEWELEVE" Then NouvEnregEleve
If NomMacro = "NEWELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFSECTION" Then NomMacro "MODIFSECTION"If NomMacro "MODIFSECTION" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "MODIFSECTION" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFSECTION" Then Wrd.Save
If NomMacro = "MODIFSECTION" Then Wrd.Workbooks.Close
If NomMacro = "MODIFSECTION" Then ModificationSection
If NomMacro = "MODIFSECTION" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFELEVE" Then NomMacro "MODIFELEVE"If NomMacro "MODIFELEVE" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "MODIFELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFELEVE" Then Wrd.Save
If NomMacro = "MODIFELEVE" Then Wrd.Workbooks.Close
If NomMacro = "MODIFELEVE" Then ModificationFicheEleve
If NomMacro = "MODIFELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "SUPSECTION" Then NomMacro "SUPSECTION"If NomMacro "SUPSECTION" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "SUPSECTION" Then Wrd.DisplayAlerts False
If NomMacro = "SUPSECTION" Then Wrd.Save
If NomMacro = "SUPSECTION" Then Wrd.Workbooks.Close
If NomMacro = "SUPSECTION" Then SupprimerSection
If NomMacro = "SUPSECTION" Then Exit Sub


If wsExcel.Cells(4, 27) "DESISTELEVE" Then NomMacro "DESISTELEVE"If NomMacro "DESISTELEVE" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "DESISTELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "DESISTELEVE" Then Wrd.Save
If NomMacro = "DESISTELEVE" Then Wrd.Workbooks.Close
If NomMacro = "DESISTELEVE" Then DesistementEleve
If NomMacro = "DESISTELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFPROF" Then NomMacro "MODIFPROF"If NomMacro "MODIFPROF" Then wsExcel.Cells(2, 28) wbExcel.Worksheets("Professeurs").Cells(2, 2).ValueIf NomMacro "MODIFPROF" Then wsExcel.Cells(2, 29) wbExcel.Worksheets("Professeurs").Cells(2, 3).ValueIf NomMacro "MODIFPROF" Then wsExcel.Cells(2, 30) wbExcel.Worksheets("Professeurs").Cells(2, 4).ValueIf NomMacro "MODIFPROF" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFPROF" Then Wrd.Save
If NomMacro = "MODIFPROF" Then Wrd.Workbooks.Close
If NomMacro = "MODIFPROF" Then ModificationProfesseur
If NomMacro = "MODIFPROF" Then Exit Sub


If wsExcel.Cells(4, 27) "DESISTPROF" Then NomMacro "DESISTPROF"If NomMacro "DESISTPROF" Then wsExcel.Cells(2, 28) wbExcel.Worksheets("Professeurs").Cells(2, 2).ValueIf NomMacro "DESISTPROF" Then wsExcel.Cells(2, 29) wbExcel.Worksheets("Professeurs").Cells(2, 3).ValueIf NomMacro "DESISTPROF" Then wsExcel.Cells(2, 30) wbExcel.Worksheets("Professeurs").Cells(2, 4).ValueIf NomMacro "DESISTPROF" Then Wrd.DisplayAlerts False
If NomMacro = "DESISTPROF" Then Wrd.Save
If NomMacro = "DESISTPROF" Then Wrd.Workbooks.Close
If NomMacro = "DESISTPROF" Then DesistementProfesseur
If NomMacro = "DESISTPROF" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFNOTES" Then NomMacro "MODIFNOTES"If NomMacro "MODIFNOTES" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "MODIFNOTES" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFNOTES" Then Wrd.Save
If NomMacro = "MODIFNOTES" Then Wrd.Workbooks.Close
If NomMacro = "MODIFNOTES" Then ModificationNotes
If NomMacro = "MODIFNOTES" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFPLANINGSECTION" Then NomMacro "MODIFPLANINGSECTION"If NomMacro "MODIFPLANINGSECTION" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "MODIFPLANINGSECTION" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFPLANINGSECTION" Then Wrd.Save
If NomMacro = "MODIFPLANINGSECTION" Then Wrd.Workbooks.Close
If NomMacro = "MODIFPLANINGSECTION" Then ModificationPlaningSection
If NomMacro = "MODIFPLANINGSECTION" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFPLANINGSALLE" Then NomMacro "MODIFPLANINGSALLE"If NomMacro "MODIFPLANINGSALLE" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "MODIFPLANINGSALLE" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFPLANINGSALLE" Then Wrd.Save
If NomMacro = "MODIFPLANINGSALLE" Then Wrd.Workbooks.Close
If NomMacro = "MODIFPLANINGSALLE" Then ModificationPlaningSalle
If NomMacro = "MODIFPLANINGSALLE" Then Exit Sub


If wsExcel.Cells(4, 27) "MODFIELEVE" Then NomMacro "MODFIELEVE"If NomMacro "MODFIELEVE" Then wsExcel.Cells(2, 28) wbExcel.Worksheets(nomfeuille).Cells(2, 2).ValueIf NomMacro "MODFIELEVE" Then wsExcel.Cells(2, 29) wbExcel.Worksheets(nomfeuille).Cells(2, 3).ValueIf NomMacro "MODFIELEVE" Then wsExcel.Cells(2, 30) wbExcel.Worksheets(nomfeuille).Cells(2, 4).ValueIf NomMacro "MODFIELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "MODFIELEVE" Then Wrd.Save
If NomMacro = "MODFIELEVE" Then Wrd.Workbooks.Close
If NomMacro = "MODFIELEVE" Then ModFiEleve
If NomMacro = "MODFIELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "DESELEVE" Then NomMacro "DESELEVE"If NomMacro "DESELEVE" Then wsExcel.Cells(2, 28) wbExcel.Worksheets(nomfeuille).Cells(2, 2).ValueIf NomMacro "DESELEVE" Then wsExcel.Cells(2, 29) wbExcel.Worksheets(nomfeuille).Cells(2, 3).ValueIf NomMacro "DESELEVE" Then wsExcel.Cells(2, 30) wbExcel.Worksheets(nomfeuille).Cells(2, 4).ValueIf NomMacro "DESELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "DESELEVE" Then Wrd.Save
If NomMacro = "DESELEVE" Then Wrd.Workbooks.Close
If NomMacro = "DESELEVE" Then Deseleve
If NomMacro = "DESELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "LISTESECTION" Then NomMacro "LISTESECTION"If NomMacro "LISTESECTION" Then wsExcel.Cells(15, 49) wsExcel.Cells(15, 49) + 1If NomMacro "LISTESECTION" Then wsExcel.Cells(15, (49 + wsExcel.Cells(15, 49))) wsExcel.Cells(1, 1).ValueIf NomMacro "LISTESECTION" Then Wrd.DisplayAlerts False
If NomMacro = "LISTESECTION" Then Wrd.Save
If NomMacro = "LISTESECTION" Then Wrd.Workbooks.Close
If NomMacro = "LISTESECTION" Then ListeEleveSection
If NomMacro = "LISTESECTION" Then Exit Sub


If wsExcel.Cells(4, 27) "LISTEIMP" Then NomMacro "LISTEIMP"If NomMacro "LISTEIMP" Then Wrd.DisplayAlerts False
If NomMacro = "LISTEIMP" Then Wrd.Save
If NomMacro = "LISTEIMP" Then Wrd.Workbooks.Close
If NomMacro = "LISTEIMP" Then ImpressionPDF
If NomMacro = "LISTEIMP" Then Exit Sub


If wsExcel.Cells(4, 27) "CREERFICHIEREXCEL" Then NomMacro "CREERFICHIEREXCEL"If NomMacro "CREERFICHIEREXCEL" Then wsExcel.Cells(2, 28) wbExcel.Worksheets("Professeurs").Cells(2, 2).ValueIf NomMacro "CREERFICHIEREXCEL" Then wsExcel.Cells(2, 29) wbExcel.Worksheets("Professeurs").Cells(2, 3).ValueIf NomMacro "CREERFICHIEREXCEL" Then Wrd.DisplayAlerts False
If NomMacro = "CREERFICHIEREXCEL" Then Wrd.Save
If NomMacro = "CREERFICHIEREXCEL" Then Wrd.Workbooks.Close
If NomMacro = "CREERFICHIEREXCEL" Then CREERFICHIEREXCEL
If NomMacro = "CREERFICHIEREXCEL" Then Exit Sub


If wsExcel.Cells(4, 27) "BULLETINSECTION" Then NomMacro "BULLETINSECTION"If NomMacro "BULLETINSECTION" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "BULLETINSECTION" Then Wrd.DisplayAlerts False
If NomMacro = "BULLETINSECTION" Then Wrd.Save
If NomMacro = "BULLETINSECTION" Then Wrd.Workbooks.Close
If NomMacro = "BULLETINSECTION" Then BulletinSection
If NomMacro = "BULLETINSECTION" Then Exit Sub


If wsExcel.Cells(4, 27) "BULLELEVESECT" Then NomMacro "BULLELEVESECT"If NomMacro "BULLELEVESECT" Then wsExcel.Cells(2, 27) wsExcel.Cells(1, 1).ValueIf NomMacro "BULLELEVESECT" Then Wrd.DisplayAlerts False
If NomMacro = "BULLELEVESECT" Then Wrd.Save
If NomMacro = "BULLELEVESECT" Then Wrd.Workbooks.Close
If NomMacro = "BULLELEVESECT" Then bullelevesect
If NomMacro = "BULLELEVESECT" Then Exit Sub


If wsExcel.Cells(4, 27) "BULLELEVE" Then NomMacro "BULLELEVE"If NomMacro "BULLELEVE" Then wsExcel.Cells(2, 28) wbExcel.Worksheets(nomfeuille).Cells(2, 2).ValueIf NomMacro "BULLELEVE" Then wsExcel.Cells(2, 29) wbExcel.Worksheets(nomfeuille).Cells(2, 3).ValueIf NomMacro "BULLELEVE" Then wsExcel.Cells(2, 30) wbExcel.Worksheets(nomfeuille).Cells(2, 4).ValueIf NomMacro "BULLELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "BULLELEVE" Then Wrd.Save
If NomMacro = "BULLELEVE" Then Wrd.Workbooks.Close
If NomMacro = "BULLELEVE" Then Bulleleve
If NomMacro = "BULLELEVE" Then Exit Sub


End Sub
Private Sub Boutoneleve2_Click()


Dim Wrd As Object
Dim wbExcel As Object
Dim wsExcel As Object
Dim NomMacro, nomfeuille As String


Set Wrd = CreateObject("Excel.Application")
Set wbExcel = Wrd.Workbooks.Open(CommonDialog1.FileName)
Set wsExcel = wbExcel.Worksheets("Liste des sections")


nomfeuille = wsExcel.Cells(2, 27).Value


If wsExcel.Cells(4, 27) "NEWELEVE" Then NomMacro "NEWELEVE"If NomMacro "NEWELEVE" Then wsExcel.Cells(2, 27) wsExcel.Cells(2, 1).ValueIf NomMacro "NEWELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "NEWELEVE" Then Wrd.Save
If NomMacro = "NEWELEVE" Then Wrd.Workbooks.Close
If NomMacro = "NEWELEVE" Then NouvEnregEleve
If NomMacro = "NEWELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFSECTION" Then NomMacro "MODIFSECTION"If NomMacro "MODIFSECTION" Then wsExcel.Cells(2, 27) wsExcel.Cells(2, 1).ValueIf NomMacro "MODIFSECTION" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFSECTION" Then Wrd.Save
If NomMacro = "MODIFSECTION" Then Wrd.Workbooks.Close
If NomMacro = "MODIFSECTION" Then ModificationSection
If NomMacro = "MODIFSECTION" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFELEVE" Then NomMacro "MODIFELEVE"If NomMacro "MODIFELEVE" Then wsExcel.Cells(2, 27) wsExcel.Cells(2, 1).ValueIf NomMacro "MODIFELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFELEVE" Then Wrd.Save
If NomMacro = "MODIFELEVE" Then Wrd.Workbooks.Close
If NomMacro = "MODIFELEVE" Then ModificationFicheEleve
If NomMacro = "MODIFELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "SUPSECTION" Then NomMacro "SUPSECTION"If NomMacro "SUPSECTION" Then wsExcel.Cells(2, 27) wsExcel.Cells(2, 1).ValueIf NomMacro "SUPSECTION" Then Wrd.DisplayAlerts False
If NomMacro = "SUPSECTION" Then Wrd.Save
If NomMacro = "SUPSECTION" Then Wrd.Workbooks.Close
If NomMacro = "SUPSECTION" Then SupprimerSection
If NomMacro = "SUPSECTION" Then Exit Sub


If wsExcel.Cells(4, 27) "DESISTELEVE" Then NomMacro "DESISTELEVE"If NomMacro "DESISTELEVE" Then wsExcel.Cells(2, 27) wsExcel.Cells(2, 1).ValueIf NomMacro "DESISTELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "DESISTELEVE" Then Wrd.Save
If NomMacro = "DESISTELEVE" Then Wrd.Workbooks.Close
If NomMacro = "DESISTELEVE" Then DesistementEleve
If NomMacro = "DESISTELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFPROF" Then NomMacro "MODIFPROF"If NomMacro "MODIFPROF" Then wsExcel.Cells(2, 28) wbExcel.Worksheets("Professeurs").Cells(3, 2).ValueIf NomMacro "MODIFPROF" Then wsExcel.Cells(2, 29) wbExcel.Worksheets("Professeurs").Cells(3, 3).ValueIf NomMacro "MODIFPROF" Then wsExcel.Cells(2, 30) wbExcel.Worksheets("Professeurs").Cells(3, 4).ValueIf NomMacro "MODIFPROF" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFPROF" Then Wrd.Save
If NomMacro = "MODIFPROF" Then Wrd.Workbooks.Close
If NomMacro = "MODIFPROF" Then ModificationProfesseur
If NomMacro = "MODIFPROF" Then Exit Sub


If wsExcel.Cells(4, 27) "DESISTPROF" Then NomMacro "DESISTPROF"If NomMacro "DESISTPROF" Then wsExcel.Cells(2, 28) wbExcel.Worksheets("Professeurs").Cells(3, 2).ValueIf NomMacro "DESISTPROF" Then wsExcel.Cells(2, 29) wbExcel.Worksheets("Professeurs").Cells(3, 3).ValueIf NomMacro "DESISTPROF" Then wsExcel.Cells(2, 30) wbExcel.Worksheets("Professeurs").Cells(3, 4).ValueIf NomMacro "DESISTPROF" Then Wrd.DisplayAlerts False
If NomMacro = "DESISTPROF" Then Wrd.Save
If NomMacro = "DESISTPROF" Then Wrd.Workbooks.Close
If NomMacro = "DESISTPROF" Then DesistementProfesseur
If NomMacro = "DESISTPROF" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFNOTES" Then NomMacro "MODIFNOTES"If NomMacro "MODIFNOTES" Then wsExcel.Cells(2, 27) wsExcel.Cells(2, 1).ValueIf NomMacro "MODIFNOTES" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFNOTES" Then Wrd.Save
If NomMacro = "MODIFNOTES" Then Wrd.Workbooks.Close
If NomMacro = "MODIFNOTES" Then ModificationNotes
If NomMacro = "MODIFNOTES" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFPLANINGSECTION" Then NomMacro "MODIFPLANINGSECTION"If NomMacro "MODIFPLANINGSECTION" Then wsExcel.Cells(2, 27) wsExcel.Cells(2, 1).ValueIf NomMacro "MODIFPLANINGSECTION" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFPLANINGSECTION" Then Wrd.Save
If NomMacro = "MODIFPLANINGSECTION" Then Wrd.Workbooks.Close
If NomMacro = "MODIFPLANINGSECTION" Then ModificationPlaningSection
If NomMacro = "MODIFPLANINGSECTION" Then Exit Sub


If wsExcel.Cells(4, 27) "MODIFPLANINGSALLE" Then NomMacro "MODIFPLANINGSALLE"If NomMacro "MODIFPLANINGSALLE" Then wsExcel.Cells(2, 27) wsExcel.Cells(2, 1).ValueIf NomMacro "MODIFPLANINGSALLE" Then Wrd.DisplayAlerts False
If NomMacro = "MODIFPLANINGSALLE" Then Wrd.Save
If NomMacro = "MODIFPLANINGSALLE" Then Wrd.Workbooks.Close
If NomMacro = "MODIFPLANINGSALLE" Then ModificationPlaningSalle
If NomMacro = "MODIFPLANINGSALLE" Then Exit Sub


If wsExcel.Cells(4, 27) "MODFIELEVE" Then NomMacro "MODFIELEVE"If NomMacro "MODFIELEVE" Then wsExcel.Cells(2, 28) wbExcel.Worksheets(nomfeuille).Cells(3, 2).ValueIf NomMacro "MODFIELEVE" Then wsExcel.Cells(2, 29) wbExcel.Worksheets(nomfeuille).Cells(3, 3).ValueIf NomMacro "MODFIELEVE" Then wsExcel.Cells(2, 30) wbExcel.Worksheets(nomfeuille).Cells(3, 4).ValueIf NomMacro "MODFIELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "MODFIELEVE" Then Wrd.Save
If NomMacro = "MODFIELEVE" Then Wrd.Workbooks.Close
If NomMacro = "MODFIELEVE" Then ModFiEleve
If NomMacro = "MODFIELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "DESELEVE" Then NomMacro "DESELEVE"If NomMacro "DESELEVE" Then wsExcel.Cells(2, 28) wbExcel.Worksheets(nomfeuille).Cells(3, 2).ValueIf NomMacro "DESELEVE" Then wsExcel.Cells(2, 29) wbExcel.Worksheets(nomfeuille).Cells(3, 3).ValueIf NomMacro "DESELEVE" Then wsExcel.Cells(2, 30) wbExcel.Worksheets(nomfeuille).Cells(3, 4).ValueIf NomMacro "DESELEVE" Then Wrd.DisplayAlerts False
If NomMacro = "DESELEVE" Then Wrd.Save
If NomMacro = "DESELEVE" Then Wrd.Workbooks.Close
If NomMacro = "DESELEVE" Then Deseleve
If NomMacro = "DESELEVE" Then Exit Sub


If wsExcel.Cells(4, 27) "LISTESECTION" Then NomMacro "LISTESECTION"If NomMacro "LISTESECTION" Then wsExcel.Cells(15, 49) wsExcel.Cells(15, 49) + 1If NomMacro "LISTESECTION" Then wsExcel.Cells(15, (49 + wsExcel.Cells(15, 49))) wsExcel.Cells(2, 1).ValueIf NomMacro "LISTESECTION" Then Wrd.DisplayAlerts False
If NomMacro = "LISTESECTION" Then Wrd.Save
If NomMacro = "LISTESECTION" Then Wrd.Workbooks.Close
If NomMacro = "LISTESECTION" Then ListeEleveSection
If NomMacro = "LISTESECTION" Then Exit Sub


If wsExcel.Cells(4, 27) "LISTEIMP" Then NomMacro "LISTEIMP"If NomMacro "LISTEIMP" Then Wrd.DisplayAlerts False
If NomMacro = "LISTEIMP" Then Wrd.Save
If NomMacro = "LISTEIMP" Then Wrd.Workbooks.Close
If NomMacro = "LISTEIMP" Then ImpressionPapier
If NomMacro = "LISTEIMP" Then Exit Sub


If wsExcel.Cells(4, 27) "CREERFICHIEREXCEL" Then NomMacro "CREERFICHIEREXCEL"If NomMacro "CREERFICHIEREXCEL" Then wsExcel.Cells(2, 28) wbExcel.Worksheets("Professeurs").Cells(3, 2).ValueIf NomMacro "CREERFICHIEREXCEL" Then wsExcel.Cells(2, 29) wbExcel.Worksheets("Professeurs").Cells(3, 3).ValueIf NomMacro "CREERFICHIEREXCEL" Then Wrd.DisplayAlerts False
If NomMacro = "CREERFICHIEREXCEL" Then Wrd.Save
If NomMacro = "CREERFICHIEREXCEL" Then Wrd.Workbooks.Close
If NomMacro = "CREERFICHIEREXCEL" Then CREERFICHIEREXCEL
If NomMacro = "CREERFICHIEREXCEL" Then Exit Sub


End Sub
Messages postés
682
Date d'inscription
vendredi 6 avril 2007
Statut
Membre
Dernière intervention
4 août 2012
6
par contre je ne vois pas vraiment la raison d'avoir 57 boutons puisqu'ils font pratiquement toujours la meme chose

[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
oups un petit oubli ^^

Private Sub SaveWRD(ByRef oWrd As Object)
    With oWrd
        .DisplayAlerts = False
        .Save
        .Workbooks.Close
    End With
End Sub
Messages postés
40
Date d'inscription
vendredi 4 avril 2008
Statut
Membre
Dernière intervention
12 septembre 2012

ok effectivement c'est plus simple mais par ex je crée 3 boutons avec add.controls (ca je sais faire)


comment faire pour que :



 si je clique sur bouton 1 alors:
Select Case wsExcel.Cells(4, 27)
    
    
        Case "NEWELEVE"
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 1
).Value
                SaveWRD Wrd
                
NouvEnregEleve



si je clique sur bouton 2 alors:
Select Case wsExcel.Cells(4, 27)
    
    
        Case "NEWELEVE"
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 2
).Value
                SaveWRD Wrd
                NouvEnregEleve






si je clique sur bouton 3 alors:
Select Case wsExcel.Cells(4, 27)
    
    
        Case "NEWELEVE"
                wsExcel.Cells(2, 27) = wsExcel.Cells(1, 3
).Value
                SaveWRD Wrd
                NouvEnregEleve




mais avec une seule macro, ce qui m'éviterais d'écrire les 75 macro et de devoir créer les 75 boutons
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
"ensuite en VB6 tu as les groupes de contrôles, ce qui permettra de ne pas avoir 75 fois le même code"

tu parles de macro? donc VBA?!!!
attention....

pose une commandbutton, copie, colle
normalement VB6 (!!!) te propose de créer un groupe de controles

de là l'évènement aura un argument integer nommé index

tu auras alors juste à les placer (les boutons) dans l'ordre que tu veux et faire :

wsExcel.Cells(2, 27) = wsExcel.Cells(1, index
).Value

++
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
Messages postés
40
Date d'inscription
vendredi 4 avril 2008
Statut
Membre
Dernière intervention
12 septembre 2012

Merci beaucoup, c'est mieux, et en créant un groupe de controle, c'est plus propre comme programmation.

Je vais me permettre de vous poser 2 autres questions (comme je vois que les gens de ce site sont compétents)
1. Est-il possible d'écrire 2 lignes dans le caption d'une forme ?
2. Comment fait-on pour définir une constante style nom d'une feuille utilisable dans toutes les macro sans devoir à chaque fois faire référence à une cellule.
Moi ce que je fais (et la aussi c'est lourd), c'est que j'écrit dans une case par ex le nom d'une feuille et quand à chaque macro, je vais voir le nom indiqué dans la feuille.

Merci encore de votre aide.
Messages postés
682
Date d'inscription
vendredi 6 avril 2007
Statut
Membre
Dernière intervention
4 août 2012
6
pour ta uestion 2 utiliser une constante n'est pas la solution puisque c'est un codage hard donc si ta sheet change de nom ça plante
utilise plutot une variable publique que tu déclares dans un module
tu fais ensuite une petite sub pour trouver le nom de la sheet à mettre dans cette variable et ensuite dans le reste de ton code il suffit d'utiliser cette variable

pour la premiere
Label = "toto" & Chr(13) & "truc"

[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE
Messages postés
682
Date d'inscription
vendredi 6 avril 2007
Statut
Membre
Dernière intervention
4 août 2012
6
lol PCPT c'est vrai que j'ai un peu merdé avec la logique !

[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE
Messages postés
40
Date d'inscription
vendredi 4 avril 2008
Statut
Membre
Dernière intervention
12 septembre 2012

Re, j'ai encore un souci, vous m'avez donné comme code pour fermer excel :


Private Sub SaveWRD(ByRef oWrd As Object)


    With oWrd
        .DisplayAlerts = False
        .Save
        .Workbooks.Close
    End With
End Sub

Et j'ai voulu l'utiliser dans d'autres macro ex:
Private Sub OuvrirFichier_Click()


Reset
Dim Wrd, wbExcel, wsExcel As Object
Dim i, ctr As Integer
Dim nomfeuille, nometab As String
Principal.CommonDialog1.ShowOpen
Set Wrd = CreateObject("Excel.Application")
Set wbExcel = Wrd.Workbooks.Open(CommonDialog1.FileName)
Set wsExcel = wbExcel.Worksheets(1)


wbExcel.Worksheets("Liste des sections").Cells(10, 27) = Date


Wrd.Visible = False


nometab = wbExcel.Worksheets("Liste des sections").Cells(1, 20)
Principal.Caption =  Date & " : Centre de " & nometab & " :                                     " & CommonDialog1.FileName & "         Ouvrir un fichier"


Principal.Eleves.Visible = True
Principal.Notes.Visible = True
Principal.Bulletins.Visible = True
Principal.Sections.Visible = True
Principal.Memos.Visible = True
Principal.professeurs.Visible = True
Principal.PlaningS.Visible = True
Principal.Enregistrer.Visible = True
Principal.EnregistrerSous.Visible = True
Principal.Cartes.Visible = True
Principal.Statistiques.Visible = True
Principal.Examens.Visible = True


Verifpaiement


wbExcel.Worksheets("Liste des sections").Cells(2, 20) = 1
wbExcel.Worksheets("Liste des Sections").Cells(3, 27) = 0
wbExcel.Worksheets("Liste des Sections").Cells(15, 49) = 0


SaveWRD Wrd
Set wsExcel = Nothing
Set wbExcel = Nothing
Set Wrd = Nothing


End Sub

Mais il me met comme erreur :
compile error
ByRef Argument type mismatch

Et il me sourligne Wrd en bleu .

Encore merci de votre aide.


 
Messages postés
40
Date d'inscription
vendredi 4 avril 2008
Statut
Membre
Dernière intervention
12 septembre 2012

Re,

J'ai rajouté Dim Wrd, wbExcel, wsExcel As Objectdans Private sub SaveWrd et ca ne change rien.
Messages postés
40
Date d'inscription
vendredi 4 avril 2008
Statut
Membre
Dernière intervention
12 septembre 2012

Re,

autant pour moi  j'avais mal lu,

je pensais que l'on pouvais mettre Dim X, V, S, E,  As Object
et est-ce que c'est pareil pour les integer, les controls, les string ...
parce que j'ai à chauqe fois mis i, u, t, y, as integer ou label, textbox as control ...
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
la déclaration sur une ligne (donc séparée par une virgule) ne dispense pas de typer... donc en effet, ce pour tous les types
++