Re : Applic fonctionne en excell 2003 mais plus en 2010 : Problème de "forme automati
Voila ou le bug se passe, si sa peux aider? :
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
Il faut aussi savoir q'une forme rectangle (qui sert de bouton pour lancer une macro) n'apparait plus sur la page en version 2010, alors qu'il exciste en version 2010