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
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
Set Sh = .Shapes.Range(Array("Picture 1", "Rectangle 1")).Regroup
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question