Applic tourne super en Excel 2003, mais bug en Excel 2010, aide svp??

Résolu
videocontact
Messages postés
13
Date d'inscription
jeudi 8 mars 2012
Statut
Membre
Dernière intervention
17 juillet 2013
- 8 mars 2012 à 14:35
MarcPL
Messages postés
172
Date d'inscription
jeudi 8 décembre 2011
Statut
Membre
Dernière intervention
21 juillet 2013
- 9 mars 2012 à 14:19
Bonjour,
j'y connais rien et je trouve pas de solutions pour résoudre le problème d'utilisations sous Excel 2010.
Le bug affiche ceci :
Sub Changementtour(Optional Init As Boolean = False)
' Init = True lors d'un nouveau concours
Dim Sh As Shape
Dim Msg As String
Dim Tour As Integer
Dim TourArr As Integer
Dim TourDep As Integer
Dim NomSh As String

' "Forme automatique 1" Pour diminuer le numéro du tour
' "Forme automatique 2" Pour augmenter le numéro du tour

Application.ScreenUpdating = False

With Sheets("Tirage Matchs")
.Unprotect

If Init = False Then
' Set Sh = .Shapes(Application.Caller) ' Quelle forme à été cliquée ?
NomSh = Application.Caller ' Quelle forme à été cliquée ?
Else
' Set Sh = .Shapes("Forme automatique 1") ' Si Init on réinitialise
NomSh = "Forme automatique 1" ' Si Init on réinitialise
End If

' Msg = Sh.TextFrame.Characters.Text
Msg = .Shapes(NomSh).TextFrame.Characters.Text

If Msg = "Fin du concours" Then
Tour = .Range("F1") + 1
NomSh = "Forme automatique 2"
Else
Tour = Val(Right(Msg, 1))
End If

' If Sh.Name = "Forme automatique 2" Then ' On augmente le tour
If NomSh = "Forme automatique 2" Then ' On augmente le tour
If Sheets("Tour").Cells(1, 20 + Tour).Value < Int(Sheets("Inscription").Range("K17") / 2) Then
MsgBox "Entrer d'abord les résultats!!!"
Exit Sub
End If

If .Range("L1") < Tour - 1 Then
Sauve " Résultat Tour " & Tour - 1
Sheets("Class tour " & Tour - 1).Visible = True
.Range("L1") = Tour - 1
End If

If Tour < .Range("F1") + 1 Then
TourArr = Tour - 1
TourDep = Tour - 2
End If
Else ' On diminue le tour
If Tour > 0 Then
TourArr IIf(Init False, Tour - 1, 0)
TourDep = Tour
Else

End If
End If

If TourDep <> 0 Or TourArr <> 0 Then
Set Sh = .Shapes.Range(Array("Forme automatique 1", "Forme automatique 2", "Groupe 1", "Groupe 2", "Rectangle 1")).Group
' On démasque le tour d'arrivé
.Range("A" & 4 + (TourArr * 133) & ":A" & 133 + (TourArr * 133)).EntireRow.Hidden = False
' On déplace les formes
Sh.Top = Range("J" & 6 + (TourArr * 133)).Top
' On masque ce tour départ
.Range("A" & 4 + (TourDep * 133) & ":A" & 136 + (TourDep * 133)).EntireRow.Hidden = True
Sh.Ungroup
'
' Modification des textes des formes
'
Set Sh = .Shapes("Groupe 1")
Sh.Ungroup
.Shapes("Rectangle 1").TextFrame.Characters.Text = " Matchs Tour " & TourArr + 1
Set Sh = .Shapes.Range(Array("Picture 1", "Rectangle 1")).Regroup
Sh.Name = "Groupe 1"

Set Sh = .Shapes("Groupe 2")
Sh.Ungroup
.Shapes("Rectangle 1").TextFrame.Characters.Text = " Scores Tour " & TourArr + 1
Set Sh = .Shapes.Range(Array("Picture 1", "Rectangle 1")).Regroup
Sh.Name = "Groupe 2"

'If .Range("J1") = TourArr + 2 Then
' .Shapes("Groupe 3").Visible (.Range("F1") TourArr + 1)
.Shapes("Rectangle 1").Visible (.Range("F1") TourArr + 1)
'Else
' .Shapes("Groupe 3").Visible = False
'End If

' Set Sh = .Shapes("Groupe 4")
' Sh.Ungroup
' .Shapes("Forme automatique 3").TextFrame.Characters.Text = "Fin" & vbLf & "Tour " & TourArr + 1
' Set Sh = .Shapes.Range(Array("Image 74", "Forme automatique 3")).Regroup
' Sh.Name = "Groupe 4"

.Shapes("Forme automatique 1").Visible Not (TourArr 0)
.Shapes("Forme automatique 2").Visible Not ((TourArr + 1) .Range("F1")) '6)

.Shapes("Forme automatique 1").TextFrame.Characters.Text = "Tour " & TourArr
.Shapes("Forme automatique 2").TextFrame.Characters.Text = "Tour " & TourArr + 2

.Range("G2") = "Tour " & TourArr + 1
End If

If Init = False Then
' MsgBox "Protection"
Application.GoTo .Range("G" & 6 + (TourArr * 133)) ', Scroll:=True
.Protect
Else
' .Shapes("Groupe 3").Visible = False
.Shapes("Rectangle 1").Visible = False
End If
End With

End Sub

Voyez-vous d'ou viendrai le problème?

Merci à vous

25 réponses

ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
236
9 mars 2012 à 11:46
Bien reçu ton screenshot.
La barre de titre n'est en effet pas là !
Problème à régler sur ta machine ! En relation avec le responsable informatique de ta boîte, au besoin !
ou change de machine pour correspondre avec ce forum !
Bon appétit.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
0
bigfish_le vrai
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
12
9 mars 2012 à 11:50
moins de 30" pour lui donner un coup

Sub Changementtour(Optional Init As Boolean = False)
    ' Init = True lors d'un nouveau concours
    Dim Sh As Shape
    Dim Msg As String
    Dim Tour As Integer
    Dim TourArr As Integer
    Dim TourDep As Integer
    Dim NomSh As String
    
    ' "Forme automatique 1" Pour diminuer le numéro du tour
    ' "Forme automatique 2" Pour augmenter le numéro du tour
    
    Application.ScreenUpdating = False
    
    With Sheets("Tirage Matchs")
        .Unprotect
        If Init = False Then
            ' Set Sh = .Shapes(Application.Caller) ' Quelle forme à été cliquée ?
            NomSh = Application.Caller ' Quelle forme à été cliquée ?
        Else
            ' Set Sh = .Shapes("Forme automatique 1") ' Si Init on réinitialise
            NomSh = "Forme automatique 1" ' Si Init on réinitialise
        End If
        
        ' Msg = Sh.TextFrame.Characters.Text
        Msg = .Shapes(NomSh).TextFrame.Characters.Text
        
        If Msg = "Fin du concours" Then
            Tour = .Range("F1") + 1
            NomSh = "Forme automatique 2"
        Else
            Tour = Val(Right(Msg, 1))
        End If
        
        ' If Sh.Name = "Forme automatique 2" Then ' On augmente le tour
        If NomSh = "Forme automatique 2" Then ' On augmente le tour
            If Sheets("Tour").Cells(1, 20 + Tour).Value < Int(Sheets("Inscription").Range("K17") / 2) Then
                MsgBox "Entrer d'abord les résultats!!!"
                Exit Sub
            End If
            If .Range("L1") < Tour - 1 Then
                Sauve " Résultat Tour " & Tour - 1
                Sheets("Class tour " & Tour - 1).Visible = True
                .Range("L1") = Tour - 1
            End If
            If Tour < .Range("F1") + 1 Then
                TourArr = Tour - 1
                TourDep = Tour - 2
            End If
        Else ' On diminue le tour
            If Tour > 0 Then
                TourArr IIf(Init False, Tour - 1, 0)
                TourDep = Tour
            Else
            
            End If
        End If
        
        If TourDep <> 0 Or TourArr <> 0 Then
            Set Sh = .Shapes.Range(Array("Forme automatique 1", "Forme automatique 2", "Groupe 1", "Groupe 2", "Rectangle 1")).Group
            ' On démasque le tour d'arrivé
            .Range("A" & 4 + (TourArr * 133) & ":A" & 133 + (TourArr * 133)).EntireRow.Hidden = False
            ' On déplace les formes
            Sh.Top = Range("J" & 6 + (TourArr * 133)).Top
            ' On masque ce tour départ
            .Range("A" & 4 + (TourDep * 133) & ":A" & 136 + (TourDep * 133)).EntireRow.Hidden = True
            Sh.Ungroup
            '
            ' Modification des textes des formes
            '
            Set Sh = .Shapes("Groupe 1")
            Sh.Ungroup
            .Shapes("Rectangle 1").TextFrame.Characters.Text = " Matchs Tour " & TourArr + 1
            Set Sh = .Shapes.Range(Array("Picture 1", "Rectangle 1")).Regroup
            Sh.Name = "Groupe 1"
            
            Set Sh = .Shapes("Groupe 2")
            Sh.Ungroup
            .Shapes("Rectangle 1").TextFrame.Characters.Text = " Scores Tour " & TourArr + 1
            Set Sh = .Shapes.Range(Array("Picture 1", "Rectangle 1")).Regroup
            Sh.Name = "Groupe 2"
            
            'If .Range("J1") = TourArr + 2 Then
                ' .Shapes("Groupe 3").Visible (.Range("F1") TourArr + 1)
                .Shapes("Rectangle 1").Visible (.Range("F1") TourArr + 1)
            'Else
                ' .Shapes("Groupe 3").Visible = False
            'End If
            
            ' Set Sh = .Shapes("Groupe 4")
            ' Sh.Ungroup
            ' .Shapes("Forme automatique 3").TextFrame.Characters.Text = "Fin" & vbLf & "Tour " & TourArr + 1
            ' Set Sh = .Shapes.Range(Array("Image 74", "Forme automatique 3")).Regroup
            ' Sh.Name = "Groupe 4"
            
            .Shapes("Forme automatique 1").Visible Not (TourArr 0)
            .Shapes("Forme automatique 2").Visible Not ((TourArr + 1) .Range("F1")) '6)
            
            .Shapes("Forme automatique 1").TextFrame.Characters.Text = "Tour " & TourArr
            .Shapes("Forme automatique 2").TextFrame.Characters.Text = "Tour " & TourArr + 2
            
            .Range("G2") = "Tour " & TourArr + 1
        End If
        
        If Init = False Then
            ' MsgBox "Protection"
            Application.Goto .Range("G" & 6 + (TourArr * 133)) ', Scroll:=True
            .Protect
        Else
            ' .Shapes("Groupe 3").Visible = False
            .Shapes("Rectangle 1").Visible = False
        End If
    End With

End Sub
0
videocontact
Messages postés
13
Date d'inscription
jeudi 8 mars 2012
Statut
Membre
Dernière intervention
17 juillet 2013

9 mars 2012 à 11:53
Ben oui, j'étais donc pas fou lol.
En tout cas, c'est la première fois que cela m'arrive même sur cette machine.
probablement un problème d'activation d'un paramètre dans les options de l'explorer...
Sur ce, bon appétit à tous.
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
236
9 mars 2012 à 13:46
je remarque personnellement la mise en commentaires (don inhibition) de quelques lignes de code ===>> ce qui, pour y voir clair, donne ceci comme code à exécuter :
Sub Changementtour(Optional Init As Boolean = False)
    Dim Sh As Shape
    Dim Msg As String
    Dim Tour As Integer
    Dim TourArr As Integer
    Dim TourDep As Integer
    Dim NomSh As String
    
    ' "Forme automatique 1" Pour diminuer le numéro du tour
    ' "Forme automatique 2" Pour augmenter le numéro du tour
    
    Application.ScreenUpdating = False
    
    With Sheets("Tirage Matchs")
        .Unprotect
        If Init = False Then
            NomSh = Application.Caller ' Quelle forme à été cliquée ?
        Else
            NomSh = "Forme automatique 1" ' Si Init on réinitialise
        End If
        Msg = .Shapes(NomSh).TextFrame.Characters.Text
        If Msg = "Fin du concours" Then
            Tour = .Range("F1") + 1
            NomSh = "Forme automatique 2"
        Else
            Tour = Val(Right(Msg, 1))
        End If
        If NomSh = "Forme automatique 2" Then ' On augmente le tour
            If Sheets("Tour").Cells(1, 20 + Tour).Value < Int(Sheets("Inscription").Range("K17") / 2) Then
                MsgBox "Entrer d'abord les résultats!!!"
                Exit Sub
            End If
            If .Range("L1") < Tour - 1 Then
                Sauve " Résultat Tour " & Tour - 1
                Sheets("Class tour " & Tour - 1).Visible = True
                .Range("L1") = Tour - 1
            End If
            If Tour < .Range("F1") + 1 Then
                TourArr = Tour - 1
                TourDep = Tour - 2
            End If
        Else ' On diminue le tour
            If Tour > 0 Then
                TourArr IIf(Init False, Tour - 1, 0)
                TourDep = Tour
            Else
            
            End If
        End If
        
        If TourDep <> 0 Or TourArr <> 0 Then
            Set Sh = .Shapes.Range(Array("Forme automatique 1", "Forme automatique 2", "Groupe 1", "Groupe 2", "Rectangle 1")).Group
            ' On démasque le tour d'arrivé
            .Range("A" & 4 + (TourArr * 133) & ":A" & 133 + (TourArr * 133)).EntireRow.Hidden = False
            ' On déplace les formes
            Sh.Top = Range("J" & 6 + (TourArr * 133)).Top
            ' On masque ce tour départ
            .Range("A" & 4 + (TourDep * 133) & ":A" & 136 + (TourDep * 133)).EntireRow.Hidden = True
            Sh.Ungroup
            '
            ' Modification des textes des formes
            '
            Set Sh = .Shapes("Groupe 1")
            Sh.Ungroup
            .Shapes("Rectangle 1").TextFrame.Characters.Text = " Matchs Tour " & TourArr + 1
            Set Sh = .Shapes.Range(Array("Picture 1", "Rectangle 1")).Regroup
            Sh.Name = "Groupe 1"
            
            Set Sh = .Shapes("Groupe 2")
            Sh.Ungroup
            .Shapes("Rectangle 1").TextFrame.Characters.Text = " Scores Tour " & TourArr + 1
            Set Sh = .Shapes.Range(Array("Picture 1", "Rectangle 1")).Regroup
            Sh.Name = "Groupe 2"
            
            .Shapes("Rectangle 1").Visible (.Range("F1") TourArr + 1)
            .Shapes("Forme automatique 1").Visible Not (TourArr 0)
            .Shapes("Forme automatique 2").Visible Not ((TourArr + 1) .Range("F1")) '6)
            .Shapes("Forme automatique 1").TextFrame.Characters.Text = "Tour " & TourArr
            .Shapes("Forme automatique 2").TextFrame.Characters.Text = "Tour " & TourArr + 2
            .Range("G2") = "Tour " & TourArr + 1
        End If
        
        If Init = False Then
            Application.Goto .Range("G" & 6 + (TourArr * 133)) ', Scroll:=True
            .Protect
        Else
            .Shapes("Rectangle 1").Visible =  False
        End If
    End With

End Sub


question toute bête : est-ce bien ce code-là (une fois épuré comme ci-dessus, qui tourne en version 2003) ?
Si "pas exactement" : c'est le code, tel qu'il était, qu'il nous faut voir !
Si "oui" :
- que vaut ( au debugger ) NomSh lorsque Init = true ?
- que vaut (également au debugger) Msg dans
Msg = .Shapes(NomSh).TextFrame.Characters.Text
La ligne dite dénoncée est la suivante :
Set Sh = .Shapes.Range(Array("Picture 1", "Rectangle 1")).Regroup

Or la méthode Regroup ne peut fonctionner que dans le cas suivant :
formes d'abord groupées et dissociées
je vois bien une instruction Group plus haut, ainsi qu'une UnGroup, mais :
tout cela s'applique à l'objet Sh qui est en fait (plus haut) le groupage de
"Forme automatique 1", "Forme automatique 2", "Groupe 1", "Groupe 2", "Rectangle 1"
mais à la condition que TourDep <> 0 ou TourArr <> 0
Or (voir plus haut) TourDep et TourArr dépendent de tour
Or Tour dépend de Msg (plus haut)
Or Msg dépend (plus haut) de NomSh
or NomSh dépend de Application.caller lorsque Init = False

Or (relire mon tout premier message dans cette discussion) : Application.Caller bogue sous version 2010 !

Va falloir tout reprendre à plat (c'est le mieux) ou être capable (ce qui ne me parait hélàs pas être le cas) de renseigner avec la plus grande précision sur ce que l'on attendrait que retourne Application.Caller.
J 'ai bien évidemment une autre idée, mais elle impliquerait la capacité à introduire au click de chaque forme une valeur pour une variable publique mise dans un module bas distinct de celui des macros, puis de remplacer Application.Caller par cette variable !
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
MarcPL
Messages postés
172
Date d'inscription
jeudi 8 décembre 2011
Statut
Membre
Dernière intervention
21 juillet 2013
2
9 mars 2012 à 14:19
Tant mieux vu les difficultés rencontrées sur ton PC du bureau !  

___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !
0