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 |
