Discussion :

[apdf1]

Bonjour,

J"ai un code qui fonctionne mais j'aimerais y portais une modification ou plutôt un complément.
J'ai sur un fichier 6 onglets nommé "BdD Films, BdD Acteurs ,BdD Noms, BdD Filmographie, BdD Biographie et BdD Récompenses.
Quand je clique sur un nom de film situé dans la feuille BdD Films en colonne "B" j"ai un Usf nommer "UsF_Films" qui apparaît avec les photos des principaux acteurs (4) du film, je clique sur une des photos pour faire apparaître un Usf nommer "UsF_Gestion", danc cette Usf j'ai un multipage "Accueil, Etat civil, Biographie, Filmographie, Récompenses".
Mon problème est que je n'arrive pas a avoir les infos qui se trouve dans mes onglets sur mon UsF.
J'ai comme code ceci.

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
Private Sub UserForm_Initialize()
  Dim LigF As Long
  Dim Rep, NomFic, sheetsUse As String
  Dim i, j As Integer
  Dim tableau() As String
  Dim MltiPg As MSForms.MultiPage
 
With UsF_Gestion
    Set MltiPg = .MultiPage1
 
  With .Frm_Selection
       .OptB_Accueil.Value = True
  End With
       .Lbl_Img_ACCUEIL.Visible = True
       .CmdB_Quitter.Visible = True
'******************
   Recup_OptB
'******************
 
  If choose Then
  sheetsUse = "BdD Noms"
  Rep = "J:\Réalisateur\"
  Else
  sheetsUse = "BdD Acteurs"
  Rep = "J:\acteur\"
 
  End If
 
 
'   Trouver la ligne correspondante au réalisateur
'   Avec la feuille contenant les noms
  With Sheets(sheetsUse)
    ' Dans la colonne
    With .Columns("B:B")
      ' En cas d'erreur : nom non trouvée, n continue
      On Error Resume Next
      ' Trouver la ligne contenant le nom
      LigF = 1  ' initialiser
      LigF = .Find(What:=NomRéalisateur, LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Row
      ' Suivi des erreurs normal
      On Error GoTo 0
    End With
    ' Si pas de ligne trouvée
    If LigF = 1 Then Exit Sub
    LigF = LigF
    ' sinon
    Me.Label5.Caption = NomRéalisateur
    Me.TextBox3.Value = .Range("A" & LigF).Value
    Me.TextBox4.Value = .Range("B" & LigF).Value
    Me.TextBox5.Value = .Range("C" & LigF).Value
    Me.TextBox6.Value = .Range("D" & LigF).Value
    Me.TextBox7.Value = .Range("E" & LigF).Value
    Me.TextBox8.Value = .Range("F" & LigF).Value
    If .Range("G" & LigF).Value <> "" Then
    Me.TextBox9.Value = .Range("G" & LigF).Value
 
    Else
    Me.TextBox9.Value = "Non décédé"
    End If
  End With
 
NomFic = Label5.Caption
 
Image1.Visible = True
If Dir(Rep & NomFic & ".jpg") <> "" Then
    Image1.Picture = LoadPicture(Rep & NomFic & ".jpg")
Else
    Image1.Picture = LoadPicture: End If
End With
 
 With MltiPg                        '................. Avec le Multipage
                                       Idx_Page = 0  '................. On définit la variable Index Page "ACCUEIL"
 
                   With .Pages(Idx_Page)
                        .Visible = True   '................. Feuille "ACCUEIL"
                        .Lbl_Img_ACCUEIL.Visible = True
                   End With
                                         .Value = Idx_Page        '................. On affiche la Feuille "ACCUEIL"
                     Application.EnableEvents = False   'On Désactive la Propriete Change du Multipage
                                .Pages(1).Visible = False  '................. Feuille "SEMAINE"
                                .Pages(2).Visible = False  '................. Feuille "MOIS"
                                .Pages(3).Visible = False  '................. Feuille "ANNEE"
                                .Pages(4).Visible = False  '................. Feuille "RENDEZ VOUS"
'                                .Pages(5).Visible = False  '................. Feuille "ACCUEIL"
'                                .Pages(6).Visible = True   '................. Feuille "CREER Rv"
                     Application.EnableEvents = True   'On Résactive la Propriete Change du Multipage
 End With 'MltiPg
 
 Dim ObjAnnee, ObjFilm As Control
Dim Cl As Classe1
Dim f, g As Integer
g = 1
Set Collect = New Collection
LigF = LigF
 
With Sheets("BdD Filmographie")
For i = 2 To 100
If .Cells(LigF, i) <> "" Then
    tableau = Split(.Cells(LigF, i), ",")
        For j = 0 To UBound(tableau)
        Set ObjAnnee = Me.MultiPage1.Pages(3).Controls.Add("forms.TextBox.1") 'Textbox gauche
        With ObjAnnee
            .Name = "TextAnnee" & g
            .Left = 12
            .Top = 1 + (g * 1) * 25
            .Width = 60
            .Height = 18
            .Text = Sheets("BdD Filmographie").Cells(1, i)
            .SpecialEffect = 0
            .BackColor = &H8000000F
            '.ForeColor = &HFFFFFF
        End With
 
        Set Cl = New Classe1
        Set Cl.TextBox = ObjAnnee
        Collect.Add Cl
 
        Set ObjFilm = Me.MultiPage1.Pages(3).Controls.Add("forms.TextBox.1") ' Textbox droite
        With ObjFilm
            .Name = "TextFilm" & g
            .Left = 90
            .Top = 1 + (g * 1) * 25
            .Width = 160
            .Height = 18
            .Text = tableau(j)
            .SpecialEffect = 0
            .BackColor = &H8000000F
            '.ForeColor = &HFFFFFF
        End With
 
        Set Cl = New Classe1
        Set Cl.TextBox = ObjFilm
        Collect.Add Cl
        g = g + 1
    Next
End If
Next
 
 
 
If g > 10 Then
MultiPage1.Pages(3).ScrollHeight = 27 * g
End If
End With
 
End Sub

Je vous remercie de votre aide
je joint mon fichier qui seras plus explicite.

Cordialement

Max