1. #1
    Invité
    Invité(e)

    Par défaut Macro pour lien hypertexte et pour masquer diapositive

    Bonsoir le forum

    on viens de me donner un ppt pour afficher les numéros d un loto sur grand écran
    ce ppt contient des macros

    sur la diapo n°1 il y a les 90 boules Quand on clic sur le contour d'un numéro ce numéro disparait pour apparaitre en grand sur la diapos n°2 et a sa taille de départ sur la diapo N° 3

    pour faire apparaitre la diapo n°2 il faut se servir de la molette de la souris ou les flèches qui se trouve en bas a gauche

    la diapo n°3 apparait au bout de 7 secondes

    pour revenir sur la diapo n°1

    Sur la diapo n°1 en haut en gauche trois carres
    Le Z sert a remettre toute les boules sur la diapo N°1 ( remise a zéro)
    Le A est un lien hypertexte qui ouvre la diapo n° 4
    Le R est un lien hypertexte qui ouvre la diapo n° 5

    Les diapos n°4 et 5 sont des diapos masquer qui apparaissent que si on clic sur A et r

    sur les diapos n°4 et 5 il y a un carre avec 1 qui est un lien hypertexte pour revenir sur la diapo n°1

    donc j ai trois questions a vous poser pour résoudre mes problèmes

    1) Comment programmer la macro pour un lien hypertexte qui fait apparaitre la diapo n°2 quand on clic sur chaque numéro de la diapo n°1

    2) comment programmer un lien hypertexte sur la diapo numéro trois pour revenir a la diapo n°1 sans que ce lien hypertexte disparaisse quand on fait une remise a zéro

    3) comment programmer une macro qui sert de lien hypertexte pour revenir a la diapo n°1 et qui masque les diapo n°4 et 5 car une fois que je me sert des lien hypertexte A et R de la diapo n°1

    les diapos n°4 et 5 apparaisse avec la molette si on fait défiler les diapos dans le sens 3 2 1

    je vous joint mon fichier

    http://www.cjoint.com/c/GAuvGQJ2Dj5

    merci d'avance pour votre aide

    cordialement

    Snoopy 07

  2. #2
    Invité
    Invité(e)

    Par défaut

    bonjour le forum

    je viens de voir que le lien pour le fichier de marche pas

    je n arrive a mettre le fichier sur le site

    alors je vous met la macro et des photos des diapos

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    Sub Auto_Open()
        Init_All
    End Sub
     
    Sub Init_All()
        ' Show all balls
        ' ---------------------------
        Dim iBingoSlides As Integer
        Dim iBingoShapes  As Integer
        Dim bBallsAreVisible As Boolean
     
        On Error Resume Next
     
        If MsgBox("Voulez-vous remettre à zéro l'ensemble des boules ?", vbOKCancel, "Redémarrage Loto") = vbOK Then
            bBallsAreVisible = True
     
            ' All slides : All balls visible
            For iBingoSlides = 1 To ActivePresentation.Slides.Count
                For iBingoShapes = 1 To ActivePresentation.Slides(iBingoSlides).Shapes.Count
                    ActivePresentation.Slides(iBingoSlides).Shapes(iBingoShapes).Visible = bBallsAreVisible
                Next iBingoShapes
            Next iBingoSlides
     
            ' Slide 02 : Clear Number and Dummy
            ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").TextFrame.TextRange.Text = "-"
            ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Delete
     
            ' Slide 03 : Hide balls
            For iBingoShapes = 1 To ActivePresentation.Slides("Slide_After").Shapes.Count
                ActivePresentation.Slides("Slide_After").Shapes(iBingoShapes).Visible = msoFalse
                'ActivePresentation.Slides("Slide_After").Shapes(iBingoShapes).Visible = msoTrue
            Next iBingoShapes
            ' Slide 03 : make the title visible
            ActivePresentation.Slides("Slide_After").Shapes("TitleBallsSorted").Visible = msoTrue
            ActivePresentation.Slides("Slide_After").Shapes("BoxNumber").Visible = msoTrue
        End If
    End Sub
     
    Sub Auto_NextSlide(Index As Long)
    '    If ActivePresentation.SlideShowWindow.View.Slide.SlideIndex = 1 Then
    '        ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").TextFrame.TextRange.Text = " "
    '    End If
    End Sub
     
    Sub Init_Balls_Before()
        Dim iBingoShapes  As Integer
        Dim sBingoShapes As String
        Dim iHorizontalOffset As Integer
        Dim bBallsAreVisible As Boolean
     
        On Error Resume Next
     
        iHorizontalOffset = 50
        ' Slide 01 : Duplicate balls
        DuplicateBallHorizontally "Slide_Before", 1, 10, iHorizontalOffset
        DuplicateBallHorizontally "Slide_Before", 11, 20, iHorizontalOffset
        DuplicateBallHorizontally "Slide_Before", 21, 30, iHorizontalOffset
        DuplicateBallHorizontally "Slide_Before", 31, 40, iHorizontalOffset
        DuplicateBallHorizontally "Slide_Before", 41, 50, iHorizontalOffset
        DuplicateBallHorizontally "Slide_Before", 51, 60, iHorizontalOffset
        DuplicateBallHorizontally "Slide_Before", 61, 70, iHorizontalOffset
        DuplicateBallHorizontally "Slide_Before", 71, 80, iHorizontalOffset
        DuplicateBallHorizontally "Slide_Before", 81, 90, iHorizontalOffset
        'DuplicateBallHorizontally 20, 29, iHorizontalOffset
     
        ' Slide 03 : Duplicate balls
        'DuplicateBallHorizontally "Slide_After", 10, 19, iHorizontalOffset
     
    End Sub
     
    Sub BallClick(oShapeBall As Shape)
        Dim iCurrentSlide As Integer
        Dim iOppositeSlide As Integer
        Dim iVerticalOffset As Integer
        iVerticalOffset = 20
     
        ' Save the current Ball and Number names
        ActivePresentation.Tags.Add "SelectedBall", oShapeBall.Name
        ActivePresentation.Tags.Add "SelectedNumber", Replace(oShapeBall.Name, "b", "n")
     
        ' Define the target slide number
        If ActivePresentation.SlideShowWindow.View.Slide.SlideIndex = 1 Then
            iCurrentSlide = 1
            iOppositeSlide = 3
     
            ' Slide 02 : Display number
            ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").TextFrame.TextRange.Text = Replace(ActivePresentation.Tags("SelectedNumber"), "n", "")
     
            ' Slide 01 : Copy the ball picture from 1st slide to 2nd one
            On Error Resume Next
            ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Delete
            On Error GoTo 0
     
            ActivePresentation.Slides("Slide_Before").Shapes(oShapeBall.Name).Copy
            ActivePresentation.Slides("Slide_Zoom").Shapes.Paste
            ActivePresentation.Slides("Slide_Zoom").Shapes(oShapeBall.Name).Name = "dummy"
            ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Visible = msoCTrue
     
            ' Slide 02 : Center the ball
            ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Left = (ActivePresentation.PageSetup.SlideWidth - ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Width) / 2
            ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Top = (ActivePresentation.PageSetup.SlideHeight - ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Height) / 2
            ' Slide 02 : Scale the ball
            ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").ScaleHeight 0.6, msoTrue, msoScaleFromMiddle
            ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").ScaleWidth 0.6, msoTrue, msoScaleFromMiddle
            ' Slide 02 : Center textbox with ball's number
            ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").Left = (ActivePresentation.PageSetup.SlideWidth - ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").Width) / 2
            ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").Top = ((ActivePresentation.PageSetup.SlideHeight - ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").Height) / 2) - iVerticalOffset
            ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").ZOrder msoBringToFront
        Else
            iCurrentSlide = 3
            iOppositeSlide = 1
        End If
     
        ' This ball is visible
        If oShapeBall.Visible Then
            ' We make it NOT visible on the opposite slide
            ActivePresentation.Slides(iCurrentSlide).Shapes(ActivePresentation.Tags("SelectedBall")).Visible = msoFalse
            ActivePresentation.Slides(iCurrentSlide).Shapes(ActivePresentation.Tags("SelectedNumber")).Visible = msoFalse
            ActivePresentation.Slides(iOppositeSlide).Shapes(ActivePresentation.Tags("SelectedBall")).Visible = msoTrue
            ActivePresentation.Slides(iOppositeSlide).Shapes(ActivePresentation.Tags("SelectedNumber")).Visible = msoTrue
     
        Else
            ' We make it visible on the opposite slide
            ActivePresentation.Slides(iCurrentSlide).Shapes(ActivePresentation.Tags("SelectedBall")).Visible = msoTrue
            ActivePresentation.Slides(iCurrentSlide).Shapes(ActivePresentation.Tags("SelectedNumber")).Visible = msoTrue
            ActivePresentation.Slides(iOppositeSlide).Shapes(ActivePresentation.Tags("SelectedBall")).Visible = msoFalse
            ActivePresentation.Slides(iOppositeSlide).Shapes(ActivePresentation.Tags("SelectedNumber")).Visible = msoFalse
        End If
     
     
    End Sub
     
    Sub GrabBall(oShapeBall As Shape)
        Dim oEffect As Effect
        Dim oShapeNumber As Shape
        Dim iVerticalOffset As Integer
        iVerticalOffset = 20
     
        ' Save the ball name
        ActivePresentation.Tags.Add "SelectedBall", oShapeBall.Name
        ' Save the ball number
        ActivePresentation.Tags.Add "SelectedNumber", Replace(oShapeBall.Name, "b", "n")
     
        ' Slide 01 : Hide the target ball
        oShapeBall.Visible = msoFalse
        ActivePresentation.Slides("Slide_Before").Shapes(ActivePresentation.Tags("SelectedNumber")).Visible = msoFalse
     
        ' Slide 02 : Display number
        ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").TextFrame.TextRange.Text = Replace(ActivePresentation.Tags("SelectedBall"), "b", "")
     
        ' Slide 01 : Copy the ball picture from 1st slide to 2nd one
        ActivePresentation.Slides("Slide_Before").Shapes(oShapeBall.Name).Copy
        ActivePresentation.Slides("Slide_Zoom").Shapes.Paste
        ActivePresentation.Slides("Slide_Zoom").Shapes(oShapeBall.Name).Name = "dummy"
        ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Visible = msoCTrue
     
        ' Slide 02 : Center the ball
        ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Left = (ActivePresentation.PageSetup.SlideWidth - ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Width) / 2
        ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Top = (ActivePresentation.PageSetup.SlideHeight - ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").Height) / 2
        ' Slide 02 : Scale the ball
        ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").ScaleHeight 0.7, msoTrue, msoScaleFromMiddle
        ActivePresentation.Slides("Slide_Zoom").Shapes("dummy").ScaleWidth 0.7, msoTrue, msoScaleFromMiddle
        ' Slide 02 : Center textbox with ball's number
        ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").Left = (ActivePresentation.PageSetup.SlideWidth - ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").Width) / 2
        ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").Top = ((ActivePresentation.PageSetup.SlideHeight - ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").Height) / 2) - iVerticalOffset
        ActivePresentation.Slides("Slide_Zoom").Shapes("txtBallName").ZOrder msoBringToFront
     
        ' Slide 03 : Copy the ball from the 1st slide to the last one
        ActivePresentation.Slides("Slide_Before").Shapes(ActivePresentation.Tags("SelectedBall")).Copy
        ActivePresentation.Slides("Slide_After").Shapes.Paste
        ActivePresentation.Slides("Slide_After").Shapes(ActivePresentation.Tags("SelectedBall")).Visible = msoTrue
        ActivePresentation.Slides("Slide_Before").Shapes(ActivePresentation.Tags("SelectedNumber")).Copy
        ActivePresentation.Slides("Slide_After").Shapes.Paste
        ActivePresentation.Slides("Slide_After").Shapes(ActivePresentation.Tags("SelectedNumber")).Visible = msoTrue
     
        ' Go to next slide
        SlideShowWindows(1).View.GotoSlide 2, msoFalse
    End Sub
     
     
    Sub RenameElement()
        Dim Name$, NameSlide$
        On Error GoTo AbortNameShape
     
        If ActiveWindow.Selection.ShapeRange.Count = 0 Then
        MsgBox "No Shapes Selected"
        Exit Sub
        End If
        Name$ = ActiveWindow.Selection.ShapeRange(1).Name
        NameSlide$ = ActiveWindow.Selection.SlideRange.Name
     
        Name$ = InputBox$("Give this shape a name", "Shape Name", Name$)
        NameSlide$ = InputBox$("Give this slide a name", "Slide Name", NameSlide$)
     
        If Name$ <> "" Then
        ActiveWindow.Selection.ShapeRange(1).Name = Name$
        End If
     
        If NameSlide$ <> "" Then
        ActiveWindow.Selection.SlideRange.Name = NameSlide$
        End If
     
     
        Exit Sub
     
    AbortNameShape:
        MsgBox Err.Description
     
    End Sub
     
    Sub DuplicateBallHorizontally(sSlideName As String, iFrom As Integer, iTo As Integer, iOffset As Integer)
        Dim iBingoShapes As Integer
     
        For iBingoShapes = iFrom To iTo - 1
            ' Duplicate balls horizontaly
            sBingoShapes = "b" & iBingoShapes
            With ActivePresentation.Slides(sSlideName).Shapes(sBingoShapes).Duplicate
                .IncrementLeft iOffset
                .Top = ActivePresentation.Slides(sSlideName).Shapes("b" & iFrom).Top
                .Name = "b" & (iBingoShapes + 1)
            End With
            ' Affect action to the ball
            With ActivePresentation.Slides(sSlideName) _
                .Shapes(sBingoShapes).ActionSettings(ppMouseClick)
                    .Action = ppActionRunMacro
                    .Run = "BallClick" '"GrabBall"
                    .AnimateAction = msoFalse
            End With
            ' Duplicate the textbox number
            sBingoShapes = "n" & iBingoShapes
            With ActivePresentation.Slides(sSlideName).Shapes(sBingoShapes).Duplicate
                .IncrementLeft iOffset
                .Top = ActivePresentation.Slides(sSlideName).Shapes("n" & iFrom).Top
                .Name = "n" & (iBingoShapes + 1)
                .TextFrame.TextRange.Text = iBingoShapes + 1
            End With
        Next iBingoShapes
    End Sub
    La diapo n°1
    Pièce jointe 237043

    La diapo n°2Pièce jointe 237052

    La diapo n°3
    Pièce jointe 237053

    La diapo n°4
    Pièce jointe 237058

    La diapo n°5
    Pièce jointe 237067



    En esperant que ca puisse vous aidez

    Cordialement
    Snoopy 07

  3. #3
    Invité
    Invité(e)

    Par défaut

    bonsoir le forum

    une derniere question est ce qu il y a une personne qui peut m 'aider sur ce forum car pour le moment plusieurs personne a regarder mon post mais personne ma dit quelque chose

    si personne peut m 'aider sur ce forum j irais poser ma question sur un autre forum

    et je fermerai mon profil car c est inutile que je reste sur ce forum si personne peut m aider

    cordialement

    Snoopy 07

  4. #4
    Expert éminent

    Homme Profil pro
    Développeur .NET
    Inscrit en
    janvier 2012
    Messages
    3 407
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 60
    Localisation : Canada

    Informations professionnelles :
    Activité : Développeur .NET
    Secteur : Finance

    Informations forums :
    Inscription : janvier 2012
    Messages : 3 407
    Points : 6 913
    Points
    6 913
    Billets dans le blog
    14

    Par défaut

    C'est la fin de semaine, et ceux qui répondent le font bénévolement, à travers leurs autres obligations. Tu veux un code gratuit, clef-en-main et tu le veux pour hier.

    Premièrement, cela peut se faire sans lien hypertexte.
    Deuxièmement, tu peux insérer des boutons ActiveX sur une diapositive et leur assigner une macro

    Troisièmement, pour sélectionner une diapositive par VBA en cours de présentation tu prends

    gotoslide

    Quatrièmement, PowerPoint 2010 a des fichiers d'aide locale pour PowerPoint et pour VBA.

    Cinquièmement, les ultimatums sont généralement de nature à faire éviter de répondre, pour ne pas devenir esclaves.

    Quand à moi, ce sera moi, ce sera mon unique réponse sur ce sujet. Peut-être que d'autres accepteront de continuer, ce sera leur décision.
    À ma connaissance, le seul personnage qui a été diagnostiqué comme étant allergique au mot effort. c'est Gaston Lagaffe.

    À force de vouloir considérer les utilisateurs comme des imbéciles patentés, on risque de se mettre dans le trouble.

    Excel n'a jamais été, n'est pas et ne sera jamais un SGBD, c'est pour cela que Excel s'appelle Excel et ne s'appelle pas Access junior.

  5. #5
    Invité
    Invité(e)

    Par défaut

    bonjour clementmarcotte

    merci pour ta réponse

    quand je vois que cinquante personne ont regarder la discussion et que personne te dit oui c 'est possible ou non on peut rien faire cela énerve un peu
    je sais bien que ce qui réponde le font bénévolement et je leur tire mon chapeau


    cordialement
    Snoopy 07

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. macro excel pour lien hypertext
    Par mikey26 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 02/04/2012, 15h53
  2. Format nombre pour lien hypertexte
    Par aleximan dans le forum IHM
    Réponses: 4
    Dernier message: 15/04/2009, 10h28
  3. macro pour liens hypertextes
    Par maternelle dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 26/11/2008, 22h32
  4. [VBA-Excel] Problème de syntaxe pour lien hypertexte
    Par matt8-5 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 04/01/2007, 12h23
  5. [css]pb font pour lien hypertext
    Par david06600 dans le forum Mise en page CSS
    Réponses: 9
    Dernier message: 06/06/2006, 12h19

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo