Discussion :

[mjpmjp]

---------------------------------------------------
pour info :
cette discussion a été réécrite entièrement (d'ou la version v2) suite à la disparition des images ...

depuis la version originale le site CINEMOTIONS a fermé ...
j'ai participé (suite à un appel de don) , mais ce site est donc fermé ...

en ce qui nous concerne , le coté interactif des exemples de codes n'est plus possible ...
mais le principe reste valable et je doit adapter un nouveau code avec ce nouveau site : The Movie Database (TMDb) ....

je posterais ce nouveau code dans une "suite" ...

en attendant je vous laisse le plaisir de découvrir cet outil
@+JP
---------------------------------------------------

bonjour,
je vais vous présenter un projet qui fonctionne
Il permet , de récupérer les informations / Data et affiches d'un film , de les écrire dans une liste et enregistrer les affiches.

la DataBase contient un seul tableau de 15000 lignes (onglet FILM)
et pour le coté pratique , un tableau de news (onglet NEWS) des films qui attendent d'avoir leur Data et Affiches ...

voila une ligne dans l'onglet NEWS , l'onglet FILM reprend exactement les mêmes entêtes



le fait de cliquer sur une ligne , alimente le "FormDataWebFilm" dans le cas ou sont bouton "Navigate" est activé , dans le cas contraire , on peut travailler sur le tableau sans solliciter le form d'extraction des data web

voila donc le form "FormDataWebFilm"



la barre des boutons reste immobile...
en dessous , sont positionnées les frames qui correspondes au boutons (4 frames)

le bouton "Options" et la frame "FrmOptions"



cette page est vide , mais dans des versions antérieures , les options sont là pour fixer par exemple 'l'état du bouton "Navigate" au démarrage...

le bouton "WebBrowser" et la frame "FrmWebBrowser"...et le bouton "Navigate"



la première bande blanche (en haut à droite) c'est la case de recherche (on peut l'utiliser)
quand le bouton "Navigate" est activé (il est bleu comme le bouton "WebBrowser")
la recherche est automatique avec le contenu de la colonne A : TITRE
une fois la fiche du film sélectionnée et que la page est chargée , on peut continuer avec l'extraction

le bouton "Extraire" et la frame "FrmExtraire"



cette page , qui n'a l'air de rien , est extrêmement complexe...
la partie la plus simple est celle qui lit la ligne sélectionnée dans le tableau
la partie "recherche" des data dans la page web est un peut plus compliqué
la partie "écriture" (pour les data de la ligne) dans les case jaunes et (pour les data web) dans les cases transparentes à demandé pas mal de réflexions
en fait les cases s'agrandissent (pour ne pas afficher les scroll) en fonction du contenu et donc tout (les bouton radio , les titres , les autres cases...) doit suivre...et le scroll de la page également
en bas : 2 boutons (bouton du bas = action , du haut = frame) ,
le bouton "Extraire" (action donc) qui lance l'extraction
le bouton "Transfert" qui lance l'écriture dans le tableau , la sauvegarde des affiches et enregistre un fichier avec l'ensemble des infos (notamment les adresses des pages acteurs , réalisateurs...)

!!! je viens de voir un petit bug Transfer et Transfert !!!

et enfin le bouton "Affiche" et la frame "FrmAffiche" ... sans surprise



dans cette vue , on voit 2 bandes de 99 contrôles images (chacune) avec la case taille de l'image et sélection et un scroll par bande
il y a également un scroll général qui permet de synchroniser les 2 bandes
la bande du haut = affiche extraite du web
la bande du bas = affiche recherchée dans le répertoire "\AFFICHE" avec le nom du titre de la colonne A et le suffixe perso A-00 (A=Affiche , 00 à 99)

la structure peut être modifié (avec bouton à droite en haut) pour voir l'affiche en plus grand



j'ai ajouté récemment le bouton du bas "Transfer" (action) pour ne pas revenir à la page "Extraire" pour transférer les données
ce simple ajout a nécessité d'agrandir en hauteur le form et maintenant il faut que j’harmonise les autres forms (fiche film , fiche acteur , recherche ) qui viennent se coller !!!
les affiches de la bande du haut sont automatiquement sélectionnées et celles du bas sont désélectionnées
quand on transfère seules les affiches sélectionnées sont numérotées et sauvegardées

la vue si dessous montre comment garder des affiches du bas ,



en fait ,
quand on clique sur une première affiche (haut ou bas) le mot "Couper" est posé sur l'affiche (on peut pas se tromper )
quand on clique sur une case vide , le mot "Coller" est posé sur cette case
il suffit de cliquer sur le bouton de droite au milieu pour effectuer le déplacement de l'affiche vers la case vide
quand on clique sur la deuxième affiche (haut ou bas) le mot "Coller" est posé sur l'affiche (on peut toujours pas se tromper )
et dans ce cas les 2 affiches son interchangées
!!!toutes les affiches du (bas) dossier qui ne sont pas sélectionnées sont supprimées !!!

voila de quoi s'occuper

Voila pour la Partie PRÉSENTATION

@+JP

[mjpmjp]

bonjour,

l'outil éditeur de cette discussion ne permet pas d'ajouter autant d'image qu'il serait utile ...
alors j'ai regroupé dans cette image l'ensemble des couleurs qui seront utilisées ...



voila une vue du "FormDataWebFilm" complétement ouvert , ce qui n'est pas nécessaire puisqu'il y a la barre de scroll (scrollWidth=2500) pour accéder aux frames
en réalité dans le VBE , le form est un peut plus large que la largeur d'une des frame (style 620)



voila la même vue mais colorée , pour bien comprendre la structure du form



la partie verte : le form --> FormDataWebFilm
la partie bleue : la frame principale --> FrmPrincipal
la partie gris bleue : la frame options --> FrmOptions
la partie jaune : la frame menu --> FrmMenu
la partie rose : la frame complement --> FrmComplement
cette frame est liée au bouton à gauche dans le menu ,
elle peut être supprimée , c'était dans le cas ou on avait besoin d'un complément , d'une aide par exemple
les parties oranges : les frames qui correspondent aux boutons du haut ,
ces frames sont presque aussi grandes que la frame options ,
elles contiennent d'autres frames qui masque la couleur orange

dans la réalité , à part "options" et "complement" , toutes le frame on le fond blanc...

une dernière chose ,
la partie noire c'est le WebBrowser



la partie verte : le form --> FormDataWebFilm



la partie bleue : la frame principale --> FrmPrincipal



la partie gris bleue : la frame options --> FrmOptions



la partie jaune : la frame menu --> FrmMenu



la partie rose : la frame complement --> FrmComplement

[mjpmjp]

bonjour,

avant de passer au code , il faut que je vous explique comment je gère les variables et autres déclarations...
en fait les variables "significatives" (pas les "n" ou "i" employé dans les boucles ) sont écrites dans un tableau dans l'onglet "SYSTEM" et un code VBA les enregistre dans un module et dans une fonction...

je peut ainsi filtrer et visualiser les variables et autres utilisé par le form (qui est le "Conteneur")
ici pour le form FormDataWebFilm



en cliquant sur un bouton , ces variables sont enregistrées dans un module



elles sont même classées en fonction de la colonne "Catégorie" et "Contener"

les modifications s'effectuent dans ce tableau et non dans le code

nous y sommes !!!

le form est appelé par un bouton dans le ruban

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
'Callback for BtnWEB_DataFilm onAction
Sub RECHERCHE_DATA_WEB_FILM(control As IRibbonControl)
    'form Data Web Film
    FormDataWebFilm.Show
End Sub

dans les propriétés du form , ShowModal = false , pour être "indépendant" de la feuille

voyons le code qui ce lance AVANT de voir le form

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
 
Private Sub UserForm_Initialize()
    '-----
    Call VariableInitialyse
    Set objFormDataWebFilm = Me
    FormDataWebFilm_IsLoad = True
    '-------------------------------
    Me.ScrollBars = fmScrollBarsNone
    '-------------------------------
    'ferme le volet complement
    Me.Height = 436
    Me.Width = 562
    '-------------------------------
    Me.FrmPrincipal.ScrollWidth = 0
    Me.FrmWebBrowser.Left = 0
    '-----
    Me.CbxGenre.RowSource = "TabxlGenre[Genre]"
    '-----
    Me.FrmAfficheZoom.Visible = False
    Me.FrmAfficheW.Width = 502
    Me.FrmAfficheD.Width = 502
    Me.ScrollBar1.Width = 502
    Me.CmdZoom.Caption = 1
    'couleur "normale"
    Me.CmdZoom.BackColor = &H8000000F
    Me.CmdZoom.ForeColor = &H80000002
    Me.ImageZoom.Picture = Nothing
    '-----
    'couleur "active"
    Me.CmdCouperColler.BackColor = &H80000002
    Me.CmdCouperColler.ForeColor = &H8000000F
    '-----
    Set objWB = FrmWebBrowser.Object("WebBrowser1")
    objWB.Silent = True
    objWB.Navigate "http://www.cinemotions.com"
    '-----
    'On boucle tant que la page n'est pas totalement chargée
    ' pTimeOut est un time out en secondes (WaitIE vaut True si Timeout)
    Dim lTimer As Double
    lTimer = Timer
    pTimeOut = 4
    Do
        DoEvents
        If objWB.readyState = READYSTATE_COMPLETE And Not objWB.Busy Then Exit Do
        If pTimeOut > 0 And Timer - lTimer > pTimeOut Then Exit Do
    Loop
 
    ' Page chargée, on continue
    Set objDoc = objWB.document
End Sub

les autres événements du form

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Private Sub UserForm_Activate()
End Sub
 
Private Sub UserForm_Terminate()
    FormDataWebFilm_IsLoad = False
End Sub

l' événement activate n'est pas utilisé !!!

[mjpmjp]

bonjour,

voila la gestion des bouton et des frames "Options" et "Complement"

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
 
'===================================================================== Form
'------------------------------------------------------- Btn Options Frm
Private Sub LblOptionsFrm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblOptionsFrm.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub LblOptionsFrm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblOptionsFrm.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub LblOptionsFrm_Click()
    If Me.LblOptionsFrm.BackColor = &H80000002 Then
        'ferme
        Me.LblOptionsFrm.BackColor = &H8000000F 'normal
        'action
        '-----
        Me.FrmOptions.Left = 600
        '-----
    Else
        'ouvre
        Me.LblOptionsFrm.BackColor = &H80000002 'actif
        'action
        '-----
        Me.FrmOptions.Left = 0
        '-----
    End If
End Sub
'------------------------------------------------------- Btn Complément Frm
Private Sub LblComplementFrm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblComplementFrm.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub LblComplementFrm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblComplementFrm.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub LblComplementFrm_Click()
    If Me.LblComplementFrm.BackColor = &H80000002 Then
        'ferme
        Me.LblComplementFrm.BackColor = &H8000000F 'normal
        'action
        '----- volet des Complement
        Me.Height = 436
        '-----
    Else
        'ouvre
        Me.LblComplementFrm.BackColor = &H80000002 'actif
        'action
        '----- volet des Complement
        Me.Height = 630
        '-----
    End If
End Sub

vous noterez non seulement l’indentation du code , mais aussi le classement des sub et fonction...
ici on a une barre ===== Form
puis dans ce form on a des -------- Btn Options Frm (pour les bouton)

vous noterez que les bouton ne sont pas des "Cmd" des "Command Button"
ici le bouton est un "Lbl" un "Label" auquel on applique un effect "Sunken" quand il est enfoncé et "Raised" quand il est relâché

le mouvement est donc "géré" par les événements "Mouse"
l'action est "gérée" par l’événement "Click" en fonction de la couleur du bouton ,
en effet , si le bouton est bleu (&H80000002) c'est qu'il est actif

La gestion de la frame
quand le bouton "Options" est activé (et donc bleu)
son action est de faire venir la frame "FrmOptions" au bord gauche du form --> Me.FrmOptions.Left = 0
quand le bouton est inactif (normal = &H8000000F) , il repousse la frame vers la droite --> Me.FrmOptions.Left = 600

Ne pas oublier que ces "glissades" se passent dans la frame principale "FrmPrincipal" et pourtant on écrit pas --> Me.FrmPrincipal.FrmOptions.left !!!???

la frame principale n'est là que pour la construction du form dans le VBE afin d'utiliser un scroll pour pouvoir "étaler" horizontalement les objects...

[mjpmjp]

bonjour,

on garde les bonnes habitudes , la gestion du code...

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
 
'===================================================================== WebBrowser
'------------------------------------------------------- Btn WebBrowser Frm
Private Sub LblWebBrowserFrm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblWebBrowserFrm.SpecialEffect = fmSpecialEffectSunken
End Sub
 
Private Sub LblWebBrowserFrm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblWebBrowserFrm.SpecialEffect = fmSpecialEffectRaised
End Sub
 
Private Sub LblWebBrowserFrm_Click()
    If Me.LblWebBrowserFrm.BackColor = &H80000002 Then
        'ferme
        Me.LblWebBrowserFrm.BackColor = &H8000000F 'normal
        'action
        '-----
        Me.FrmWebBrowser.Left = 1200
        '-----
    Else
        'ouvre
        Me.LblWebBrowserFrm.BackColor = &H80000002 'actif
        Me.LblExtraireFrm.BackColor = &H8000000F 'normal
        Me.LblAfficheFrm.BackColor = &H8000000F 'normal
        'action
        '-----
        Me.FrmWebBrowser.Left = 0
        Me.FrmExtraire.Left = 1200
        Me.FrmAffiche.Left = 1200
        '-----
    End If
End Sub
 
'------------------------------------------------------- Btn Navigate
Private Sub LblNavigate_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblNavigate.SpecialEffect = fmSpecialEffectSunken
End Sub
 
Private Sub LblNavigate_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblNavigate.SpecialEffect = fmSpecialEffectRaised
End Sub
 
Private Sub LblNavigate_Click()
    If Me.LblNavigate.BackColor = &H80000002 Then
        'ferme
        Me.LblNavigate.BackColor = &H8000000F 'normal
        'action
        '-----
        FormDataWebFilm_IsNavigate = False
        '-----
    Else
        'ouvre
        Me.LblNavigate.BackColor = &H80000002 'actif
        'action
        '-----
        FormDataWebFilm_IsNavigate = True
        '-----
        If objFormDataWebFilm.TxbTitreList.Value <> "" Then
            WBAdress = "http://www.cinemotions.com/recherche/" & LCase(Trim(Replace(objFormDataWebFilm.TxbTitreList.Value, " - ", "-")))
            objWB.Navigate (WBAdress)
        End If
        '-----
    End If
End Sub

ici , on pousse les frames un peut plus loin : 1200
quand le bouton WebBrowser est actif , les autres (frame) sont déactivés
idem pour les frames , quand celle du WebBrowser vient à left=0 , les autres sont repoussées à left = 1200

le bouton "Navigate"
il se charge de la variable "FormDataWebFilm_IsNavigate" qui a certainement sont utilité et qu'on retrouvera plus tard
pour le moment , le bouton fait son boulot , il est actif --> il navigue --> FormDataWebFilm_IsNavigate = true

quand on active le bouton , il vérifie si la TextBox qui contient un titre de film (en provenance de la colonne A:TITRE") est vide ou pas...
si elle n'est pas vide , il construit une adresse web pour le navigateur
Astuce : pour ce site , plutôt que d'essayer d'écrire dans la case recherche , de simuler un click,...
il suffit de formater le titre , sans espace , en minuscule , et de le coller à "http://www.cinemotions.com/recherche/" le tout dans une variable "WBAdress"
et de lancer la navigation avec : objWB.Navigate (WBAdress)

je vous rappelle ce bout de code dans UserForm_Initialize

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
'-----
    Set objWB = FrmWebBrowser.Object("WebBrowser1")
    objWB.Silent = True
    objWB.Navigate "http://www.cinemotions.com"
    '-----

c'est là que l'object objWB à été déterminé comme étant l'object "WebBrowser1" contenu dans la frame FrmWebBrowser

je dois avouer que je n'est pas trouvé (dans ma liste de variables et autres) la déclaration de l'object "objWB"
est ce que "Set" suffit pour déclarer ???...tien voila du boulot pour notre amis Unparia ou un autre

[mjpmjp]

bonjour,

toujours le même schémas , on active , on pousse ,...

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
 
'===================================================================== Extraire
'------------------------------------------------------- Btn Extraire Frm
Private Sub LblExtraireFrm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblExtraireFrm.SpecialEffect = fmSpecialEffectSunken
End Sub
 
Private Sub LblExtraireFrm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblExtraireFrm.SpecialEffect = fmSpecialEffectRaised
End Sub
 
Private Sub LblExtraireFrm_Click()
    If Me.LblExtraireFrm.BackColor = &H80000002 Then
        'ferme
        Me.LblExtraireFrm.BackColor = &H8000000F 'normal
        'action
        '-----
        Me.FrmExtraire.Left = 1200
        '-----
    Else
        'ouvre
        Me.LblWebBrowserFrm.BackColor = &H8000000F 'normal
        Me.LblExtraireFrm.BackColor = &H80000002 'actif
        Me.LblAfficheFrm.BackColor = &H8000000F 'normal
        'action
        '-----
        Me.FrmWebBrowser.Left = 1200
        Me.FrmExtraire.Left = 0
        Me.FrmAffiche.Left = 1200
        '-----
    End If
End Sub
 
'------------------------------------------------------- Btn Extraire
Private Sub LblExtraire_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblExtraire.SpecialEffect = fmSpecialEffectSunken
End Sub
 
Private Sub LblExtraire_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblExtraire.SpecialEffect = fmSpecialEffectRaised
End Sub
 
Private Sub LblExtraire_Click()
    If Me.LblExtraire.BackColor = &H80000002 Then
        'ferme
        Me.LblExtraire.BackColor = &H8000000F 'normal
    Else
        'ouvre
        Me.LblExtraire.BackColor = &H80000002 'actif
        'action
        FormDataWebFilm_IsChangeInProgress = True
        '-----
        Call DataFilmWebExtraire(objFormDataWebFilm)
        Call DataFilmWebOrganiser
        Call DataFilmWebEfface(objFormDataWebFilm)
        Call DataFilmWebLire(objFormDataWebFilm)
        Call DataFilmWebOption(objFormDataWebFilm)
        '----- efface affiche
        Call AfficheFormEffaceWeb(objFormDataWebFilm)
        Call DataFilmAfficheWeb(objFormDataWebFilm)
        Call AffichesPageWeb(objFormDataWebFilm)
        '-----
        FormDataWebFilm_IsChangeInProgress = False
        'bouton
        Me.LblExtraire.BackColor = &H8000000F 'normal
    End If
End Sub
 
'------------------------------------------------------- Btn Transfer 2 (FrmExtraire)
Private Sub LblTransfer2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblTransfer2.SpecialEffect = fmSpecialEffectSunken
End Sub
 
Private Sub LblTransfer2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblTransfer2.SpecialEffect = fmSpecialEffectRaised
End Sub
 
Private Sub LblTransfer2_Click()
    If Me.LblTransfer2.BackColor = &H80000002 Then
        'ferme
        Me.LblTransfer2.BackColor = &H8000000F 'normal
    Else
        'ouvre
        Me.LblTransfer2.BackColor = &H80000002 'actif
        'action
        FormDataWebFilm_IsChangeInProgress = True
        '-----
        Call DataFilmTransfer(objFormDataWebFilm)
        Call DataFilmAfficheTransfer(objFormDataWebFilm)
        Call DataFilmFichierCreer(objFormDataWebFilm)
        '-----
        FormDataWebFilm_IsChangeInProgress = False
        'bouton
        Me.LblTransfer2.BackColor = &H8000000F 'normal
    End If
End Sub

attention...çà ne rigole plus , une nouvelle variable , "FormDataWebFilm_IsChangeInProgress" , là çà veut dire...je suis en train de travailler !!!
vous avez vu la masse de travail ...houla...bon ben on verra çà dans la partie EXTRACTION DATA WEB

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
FormDataWebFilm_IsChangeInProgress = True
        '-----
        Call DataFilmWebExtraire(objFormDataWebFilm)
        Call DataFilmWebOrganiser
        Call DataFilmWebEfface(objFormDataWebFilm)
        Call DataFilmWebLire(objFormDataWebFilm)
        Call DataFilmWebOption(objFormDataWebFilm)
        '----- efface affiche
        Call AfficheFormEffaceWeb(objFormDataWebFilm)
        Call DataFilmAfficheWeb(objFormDataWebFilm)
        Call AffichesPageWeb(objFormDataWebFilm)
        '-----
        FormDataWebFilm_IsChangeInProgress = False

pour la frame Affiche , vous avez compris le mécanisme , c'est pas utile d'en rajouter

voila pour la partie STRUCTURE DU FORM

@+JP

[mjpmjp]

Bonjour,

le form est appelé par un bouton dans le ruban

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
'==================================================================================================== WEB Data
'Callback for BtnWEB_DataFilm onAction
Sub RECHERCHE_DATA_WEB_FILM(control As IRibbonControl)
    'form Data Web Film
    FormDataWebFilm.Show
End Sub

nous y reviendrons plus tard , mais il faut savoir comment sont déclaré objWB et objDoc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Public objWB As SHDocVw.WebBrowser 
Public objDoc As MSHTML.HTMLDocument

dans l’événement UserForm_Initialize
l'object objFormDataWebFilm est initialisé : Set objFormDataWebFilm = Me

à quoi çà sert ?
le nom du form est FormDataWebFilm , dans le cas ou je renomme le form en "UsfDataWeb" ,
on a pas besoin de modifier le code qui utilise objFormDataWebFilm , car dans tous les cas il représente le Form

dans le même esprit , on initialise l'object objWB qui va représenter l'object WebBrowser :
Set objWB = FrmWebBrowser.Object("WebBrowser1")

on demande de ne pas afficher de message en provenance du navigateur : objWB.Silent = True
ici , on a utilisé sont représentant objWB , on aurait pu utiliser "Me"

et on lance la navigation , on appelle une page web : objWB.navigate "http://www.cinemotions.com"



ici , le bouton "Navigate" n'est pas activé ,
on a vu , plus haut , ce qui se passe quand on active le bouton...

[mjpmjp]

Bonjour,

je rappelle que pour pouvoir utiliser la Feuille et le Form en même temps ,
il faut que dans les propriétés du form : ShowModal = False

voyons le code du bouton "Navigate"

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
 
'------------------------------------------------------- Btn Navigate
Private Sub LblNavigate_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblNavigate.SpecialEffect = fmSpecialEffectSunken
End Sub
 
Private Sub LblNavigate_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblNavigate.SpecialEffect = fmSpecialEffectRaised
End Sub
 
Private Sub LblNavigate_Click()
    If Me.LblNavigate.BackColor = &H80000002 Then
        'ferme
        Me.LblNavigate.BackColor = &H8000000F 'normal
        'action
        '-----
        FormDataWebFilm_IsNavigate = False
        '-----
    Else
        'ouvre
        Me.LblNavigate.BackColor = &H80000002 'actif
        'action
        '-----
        FormDataWebFilm_IsNavigate = True
        '-----
        If objFormDataWebFilm.TxbTitreList.Value <> "" Then
            WBAdress = "http://www.cinemotions.com/recherche/" & LCase(Trim(Replace(objFormDataWebFilm.TxbTitreList.Value, " - ", "-")))
            objWB.navigate (WBAdress)
        End If
        '-----
    End If
End Sub

on voit bien le mécanisme quand on active le bouton ,
le code teste si la TextBox du Titre (qui est dans la frame FrmData) contient le Titre d'un Film :
If objFormDataWebFilm.TxbTitreList.Value <> "" Then
si c'est le cas , il construit l'adresse WBAdress qui va être utilisée pour la navigation : objWB.navigate (WBAdress)

et le plus important , il met à "True" la variable FormDataWebFilm_IsNavigate : FormDataWebFilm_IsNavigate = True
cette variable va être testée par un événement de la Feuille

La Feuille / Onglet / Sheet...NEWS et FILM
dans le code de l'onglet , il y a 3 éventements :

Activate() : quand l'onglet est ouvert / sélectionné

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub Worksheet_Activate()
    Call VariableInitialyse
    Call FILMS_NewLabel(Application.WorksheetFunction.Sum(Range(ListColonInd & ListLigneDebut & ":" & ListColonInd & ListLigneFinMax)), False)
    Call WorksheetActivate
End Sub

les variables sont initialisées avec Call VariableInitialyse (on la vu , dans la gestion des variables et autres) ,
ensuite , le Ruban "Ribbon" (le Menu d'Excel) est modifié avec FILMS_NewLabel(Data As String, Redessine As Boolean)

Excel 2016 ...

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
 
Public Function FILMS_NewLabel(Data As String, Redessine As Boolean)
    Dim n As Integer
    On Error GoTo ErrRuban
    NewLabel_List = "Liste "
    For n = 1 To 4 - Len(Data)
        NewLabel_List = NewLabel_List & "0"
    Next n
    NewLabel_List = NewLabel_List & Data & " FILM"
    'redessine le cotrole Label "TabList" du ruban
    If Redessine Then objRuban.InvalidateControl ("TabList")
    Exit Function
ErrRuban:
    Set objRuban = Ribbon
    Resume Next
End Function

Deactivate() : quand on quitte l'onglet , le compteur est mis à Zéro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Private Sub Worksheet_Deactivate()
    If Test_OperationEnCours Then Exit Sub
    Call WorksheetDeactivate
End Sub

SelectionChange(ByVal Target As Range) : quand on clique dans la feuille , on sélectionne une cellule

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Test_OperationEnCours Then Exit Sub
    Set ListCelluleSelected = Target
    Call WorksheetSelectionChange(Target)
End Sub

c'est ICI que débute l' InterAction entre la Feuille et le Form
ces 3 évènements appellent des codes communs à plusieurs Feuilles qui sont dans le Module : JP_System_WorkSheet
pour Activate() et Deactivate() qui gèrent la modif du "Ribbon"

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
 
Public Sub WorksheetActivate()
On Error GoTo ErrVariables
    'mémorise ListTotalFilmNumber
    Cell_ListTotalFilmNumber.Value = Application.WorksheetFunction.Sum(Worksheets(ActiveSheet.Name).Range(ListColonInd & ListLigneDebut & ":" & ListColonInd & ListLigneFinMax))
    Call FILMS_NewLabel(Cell_ListTotalFilmNumber.Value, True)
    'mémorise ListTotalFilmOctet
    Cell_ListTotalFilmOctet.Value = Application.WorksheetFunction.Sum(Worksheets(ActiveSheet.Name).Range(ListColonCdTotal & ListLigneDebut & ":" & ListColonCdTotal & ListLigneFinMax))
    Exit Sub
ErrVariables:
    Call VariableInitialyse
    Resume Next
End Sub
 
Public Sub WorksheetDeactivate()
On Error GoTo ErrRuban
    NewLabel_List = "Liste " & "0000 FILM"
    'redessine le cotrole Label "TabList" du ruban
    objRuban.InvalidateControl ("TabList")
    Exit Sub
ErrRuban:
    Set objRuban = Ribbon
    Resume Next
End Sub

pour SelectionChange(ByVal Target As Range)

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
 
Public Sub WorksheetSelectionChange(Target As Range)
    'cellule sélectionnée
    Set ListCelluleSelected = Target
    'Ligne de la cellule sélectionnée
    ListLigneSelected = Target.Row
    'Colonne de la cellule sélectionnée
    ListColonNumSelected = Target.Column
    OngletName = ActiveSheet.Name
    '-----
    Select Case OngletName
        Case OngletListNews, OngletListFilms
            If FormFicheFilm_IsLoad Then Call WorksheetAction_FormFicheFilm
            If FormDataWebFilm_IsLoad And Not FormDataWebFilm_IsChangeInProgress Then Call WorksheetAction_FormDataWebFilm
            If FormDataWebActeur_IsLoad And Not FormDataWebActeur_IsChangeInProgress Then Call WorksheetAction_FormDataWebActeur
        Case OngletListActeur
            If FormDataWebActeur_IsLoad And Not FormDataWebActeur_IsChangeInProgress Then Call WorksheetAction_FormDataWebActeur
        Case OngletListVBC
            If FormProcView_IsLoad Then Call WorksheetAction_FormProcView
        Case Else
            Exit Sub
    End Select
End Sub

[mjpmjp]

Bonjour,

quand on sélectionne une cellule dans la Feuille ,
l’événement : Worksheet_SelectionChange(ByVal Target As Range)
est sollicité / déclenché , "un double" de la cellule est créé dans l'object "Target"...
je dis "un double" à cause de "ByVal"
ensuite, le code teste si une opération (perso , non système) est en cours ,
si tout va bien , le code appelle "la Tour de Contrôle" : WorksheetSelectionChange(Target As Range) ,
et lui transmet le double de la cellule (qui a été sélectionnée )...

comme toutes les "Tour de Contrôle" , WorksheetSelectionChange va contrôler et aiguiller en fonction de la situation...

en premier , un autre double est fait (??? ) : Set ListCelluleSelected = Target ,
on détermine le Numéro de ligne de la cellule : ListLigneSelected = Target.Row
on détermine le Numéro de la colonne : ListColonNumSelected = Target.Column

Notez : le "Num" dans ListColonNumSelected pour ne pas confondre avec ListColonSelected ,
c'est un détail qui a son importance ....

maintenant ,
un premier contrôle : quel est l'onglet actif ?
ici encore , des variables (qui représentent les Onglets) sont utilisées et non directement le nom des Onglets...
si le nom de l'onglet change , on initialise la variable avec le nouveau nom...
OngletListNews = "NEWS" ... OngletListFilms = "FILM"

un deuxième contrôle : quel est le form chargé ?
souvenez vous le début du code de l’évènement UserForm_Initialize()

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Private Sub UserForm_Initialize()
    '-----
    Call VariableInitialyse
    Set objFormDataWebFilm = Me
    FormDataWebFilm_IsLoad = True
    '-------------------------------
    Me.ScrollBars = fmScrollBarsNone

et bien , le contrôle est justement : If FormDataWebFilm_IsLoad ... (s'il est "True") ,
mais pas seulement !! , il ne faut pas que le form soit en train de "travailler" : And Not FormDataWebFilm_IsChangeInProgress
si tout est ...OK...alors la "Tour de Contrôle" aiguille vers une procédure (sub) spécialisée et spécifique pour cette situation
Call WorksheetAction_FormDataWebFilm

[mjpmjp]

bonjour,

j'ai regroupé tout ce qui concerne les onglets dans le Module : JP_System_WorkSheet

la procédure spécifique qui nous intéresse c'est WorksheetAction_FormDataWebFilm()

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
 
'================================================================================================================================ WorksheetAction
Public Sub WorksheetAction_FormDataWebFilm()
    'si ActiveCell -> Target  est dans le tableau xl
    If Not Application.Intersect(ListCelluleSelected, ActiveSheet.Range(ListColonDebut & ListLigneDebut & ":" & ListColonFin & ListLigneFinMax)) Is Nothing Then
        DataTitre = ActiveSheet.Range(ListColonTitre & ListLigneSelected).Value
        objFormDataWebFilm.Caption = DataTitre
        'objFormDataWebFilm.TxbDataRecherche.Value = DataTitre
        objFormDataWebFilm.Repaint
        Call DataFilmListEfface(objFormDataWebFilm)
        Call DataFilmWebEfface(objFormDataWebFilm)
        Call AfficheFormEfface(objFormDataWebFilm)
 
        Call DataFilmListLire(objFormDataWebFilm, ActiveSheet.Name, ListLigneSelected)
        Call DataFilmWebOption(objFormDataWebFilm)
        Call DataFilmAfficheDossier(objFormDataWebFilm)
 
        'attention...nouvelles..contraintes..!!!
        'recherche = Lcase , avec des num 0..9 relié par "-" , pas espace
        If FormDataWebFilm_IsNavigate Then
            Titre = Split(DataTitre, "(")(0)
            Titre = Trim(Titre)
            Titre = LCase(Titre)
            Titre = Replace(Titre, " - ", "-")
            Titre = Replace(Titre, " ", "-")
            Titre = Replace(Titre, "'", "-")
            WBAdress = "http://www.cinemotions.com/recherche/" & Titre
            'objFormDataWebFilm.Caption = WBAdress
            objWB.navigate (WBAdress)
        End If
    End If
End Sub

un dernier contrôle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
'si ActiveCell -> Target  est dans le tableau xl
    If Not Application.Intersect(ListCelluleSelected, ActiveSheet.Range(ListColonDebut & ListLigneDebut & ":" & ListColonFin & ListLigneFinMax)) Is Nothing Then

ce contrôle consiste à vérifier si la cellule a été sélectionnée dans le périmètre du Tableau / DataBase
le "double : Target" n'a pas été transmit , c'est pour cela qu'est utilisé l'autre "double : ListCelluleSelected"

habituellement ,pour connaitre la ligne de fin , on utilise : Sheets(NomDeOnglet).Range("A" & Rows.Count).End(xlUp).Row ,
ici , on utilise la variable : ListLigneFinMax qui a été enregistrée dans le tableau de l'onglet "SYSTEM"



je vois que j'ai enregistré cette variable comme "variant" et non comme"double"...je n'ai plus qu'à modifier et lancer la gestion des variables...

si on est dans le cadre , on va lire le Titre du Film ,
dans la colonne : ListColonTitre à la ligne : ListLigneSelected ,
et on le stocke dans la variable : DataTitre
DataTitre = ActiveSheet.Range(ListColonTitre & ListLigneSelected).Value

pour indiquer à l'utilisateur que on a bien ciblé la ligne du Film ,
on écrit le Titre du Film dans le "Caption" du Form : objFormDataWebFilm.Caption = DataTitre
et pour être sur de voir le résultat , on redessine le Form à l'écran : objFormDataWebFilm.Repaint

les appels qui suivent , vont être étudiés plus bas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Call DataFilmListEfface(objFormDataWebFilm)
        Call DataFilmWebEfface(objFormDataWebFilm)
        Call AfficheFormEfface(objFormDataWebFilm)
 
        Call DataFilmListLire(objFormDataWebFilm, ActiveSheet.Name, ListLigneSelected)
        Call DataFilmWebOption(objFormDataWebFilm)
        Call DataFilmAfficheDossier(objFormDataWebFilm)

une dernière vérification
encore le bouton "Navigate"... If FormDataWebFilm_IsNavigate Then
est ce que l' InterAction entre la Feuille et le Form est Activée ?

oui ?... alors on formate le Titre et on construit l'adresse pour la recherche dans le navigateur :
WBAdress = "http://www.cinemotions.com/recherche/" & Titre

et on lance la recherche : objWB.navigate (WBAdress)

Résultat



même si la cellule sélectionnée était dans la colonne "Année" , la recherche à fonctionné

dans la page du navigateur , on sélectionne la Fiche du Film...comme dans un navigateur "normal"

Résultat



la Fiche du Film ...

voila pour la partie WEBBROWSER

@+JP

[mjpmjp]

Bonjour,

pour la frame WebBrowser , je n'est pas détaillé / démonté la structure ,
tout était dit dans la partie structure du form , une frame FrmWebBrowser qui contient un contrôle WebBrowser et un bouton...

pour la frame Extraire , c'est autre chose attention gros chantier...



çà c'est ce que voit l'utilisateur !!!

et çà c'est la structure de la frame Extraire



les codes couleur n'ont pas changés ,
le vert : le form
le bleu : la frame principale : FrmPrincipal --> qui sert uniquement à ajouter horizontalement des object (ici des frames) avec le scroll sur le form
le orange : la frame "action" : FrmExtraire --> qui ce déplace dans la frame principale --> si activée : left=0 ... si non left = 1200
le bordeau : la frame "scroll" : FrmExtraireData --> qui est à l’intérieur de la FrmExtraire et qui contient FrmData
le gris clair : la frame "data" : FrmData --> qui est à l’intérieur de FrmExtraireData

soit : FormDataWebFilm.FrmPrincipal.FrmExtraire.FrmExtraireData.FrmData ... ...
dans la réalité cette hiérarchie ne fonctionne pas !!?? ...
c'est LE FORM qui contient TOUTES LES FRAMES !!??... ...

pour accéder à la TextBox qui est dans la dernière frame : FrmData ...
FormDataWebFilm.TxbTitreList.Value = ""

la frame FrmExtraireData comme FrmPrincipal est utilisée pour ajouter verticalement des objects , mais contrairement à FrmPrincipal l'utilisateur se sert du scroll pour accéder au contrôles

les tableaux des propriétés servent à comprendre la configuration des scrolls

FrmExtraire



FrmExtraireData



FrmData



voila pour la structure , maintenant place au code

[mjpmjp]

Bonjour,

pour rappel , dans la procédure : WorksheetAction_FormDataWebFilm ,
dans un premier temps on vidait les frames

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
        Call DataFilmListEfface(objFormDataWebFilm)
        Call DataFilmWebEfface(objFormDataWebFilm)
        Call AfficheFormEfface(objFormDataWebFilm)

puis on chargeait les Data en provenance du PC

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
        Call DataFilmListLire(objFormDataWebFilm, ActiveSheet.Name, ListLigneSelected)
        Call DataFilmWebOption(objFormDataWebFilm)
        Call DataFilmAfficheDossier(objFormDataWebFilm)

notez : que les TxtBox jaune sont liées au PC et celle transparente (gris clair) sont liées au Web



donc Call DataFilmListEfface(objFormDataWebFilm) efface les "cases" jaunes
le code qui suit efface les "cases" jaunes uniquement , mais , il les repositionne et repositionne aussi les "cases" gris clair et aussi les boutons et titres
pour comprendre ce code:
TxbMusiqueList ---> "case" jaune --> pc
TxbMusique (sans list) --> "case" gris clair --> web

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
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
 
Public Sub DataFilmListEfface(objForm As Object)
    FormDataWebFilm_IsChangeInProgress = True
    With objForm
        .TxbTitreList.Value = ""
        .TxbAliasList.Value = ""
        .TxbAnneeList.Value = ""
        .TxbGenreList.Value = ""
    End With
 
    With objForm
        With .TxbResumeList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblRealisateur.Top = .TxbResumeList.Top + .TxbResumeList.Height + 5
        .TxbRealisateur.Top = .LblRealisateur.Top + .LblRealisateur.Height + 5
        .OptionRealisateur.Top = .TxbRealisateur.Top + 2
        '-----
        .TxbRealisateurList.Top = .TxbRealisateur.Top + .TxbRealisateur.Height + 5
        .OptionRealisateurList.Top = .TxbRealisateurList.Top + 2
    End With
 
    With objForm
        With .TxbRealisateurList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblActeur.Top = .TxbRealisateurList.Top + .TxbRealisateurList.Height + 5
        .TxbActeur.Top = .LblActeur.Top + .LblActeur.Height + 5
        .OptionActeur.Top = .TxbActeur.Top + 2
        '-----
        .TxbActeurList.Top = .TxbActeur.Top + .TxbActeur.Height + 5
        .OptionActeurList.Top = .TxbActeurList.Top + 2
    End With
 
    With objForm
        With .TxbActeurList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblEcriture.Top = .TxbActeurList.Top + .TxbActeurList.Height + 5
        .TxbEcriture.Top = .LblEcriture.Top + .LblEcriture.Height + 5
        .OptionEcriture.Top = .TxbEcriture.Top + 2
        '-----
        .TxbEcritureList.Top = .TxbEcriture.Top + .TxbEcriture.Height + 5
        .OptionEcritureList.Top = .TxbEcritureList.Top + 2
    End With
    With objForm
        With .TxbEcritureList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblProduction.Top = .TxbEcritureList.Top + .TxbEcritureList.Height + 5
        .TxbProduction.Top = .LblProduction.Top + .LblProduction.Height + 5
        .OptionProduction.Top = .TxbProduction.Top + 2
        '-----
        .TxbProductionList.Top = .TxbProduction.Top + .TxbProduction.Height + 5
        .OptionProductionList.Top = .TxbProductionList.Top + 2
    End With
    With objForm
        With .TxbProductionList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblMontage.Top = .TxbProductionList.Top + .TxbProductionList.Height + 5
        .TxbMontage.Top = .LblMontage.Top + .LblMontage.Height + 5
        .OptionMontage.Top = .TxbMontage.Top + 2
        '-----
        .TxbMontageList.Top = .TxbMontage.Top + .TxbMontage.Height + 5
        .OptionMontageList.Top = .TxbMontageList.Top + 2
    End With
    With objForm
        With .TxbMontageList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblPhotographie.Top = .TxbMontageList.Top + .TxbMontageList.Height + 5
        .TxbPhotographie.Top = .LblPhotographie.Top + .LblPhotographie.Height + 5
        .OptionPhotographie.Top = .TxbPhotographie.Top + 2
        '-----
        .TxbPhotographieList.Top = .TxbPhotographie.Top + .TxbPhotographie.Height + 5
        .OptionPhotographieList.Top = .TxbPhotographieList.Top + 2
    End With
    With objForm
        With .TxbPhotographieList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblMusique.Top = .TxbPhotographieList.Top + .TxbPhotographieList.Height + 5
        .TxbMusique.Top = .LblMusique.Top + .LblMusique.Height + 5
        .OptionMusique.Top = .TxbMusique.Top + 2
        '-----
        .TxbMusiqueList.Top = .TxbMusique.Top + .TxbMusique.Height + 5
        .OptionMusiqueList.Top = .TxbMusiqueList.Top + 2
    End With
    With objForm
        With .TxbMusiqueList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblCostume.Top = .TxbMusiqueList.Top + .TxbMusiqueList.Height + 5
        .TxbCostume.Top = .LblCostume.Top + .LblCostume.Height + 5
        .OptionCostume.Top = .TxbCostume.Top + 2
        '-----
        .TxbCostumeList.Top = .TxbCostume.Top + .TxbCostume.Height + 5
        .OptionCostumeList.Top = .TxbCostumeList.Top + 2
    End With
    With objForm
        With .TxbCostumeList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblDecor.Top = .TxbCostumeList.Top + .TxbCostumeList.Height + 5
        .TxbDecor.Top = .LblDecor.Top + .LblDecor.Height + 5
        .OptionDecor.Top = .TxbDecor.Top + 2
        '-----
        .TxbDecorList.Top = .TxbDecor.Top + .TxbDecor.Height + 5
        .OptionDecorList.Top = .TxbDecorList.Top + 2
    End With
    With objForm
        With .TxbDecorList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblCasting.Top = .TxbDecorList.Top + .TxbDecorList.Height + 5
        .TxbCasting.Top = .LblCasting.Top + .LblCasting.Height + 5
        .OptionCasting.Top = .TxbCasting.Top + 2
        '-----
        .TxbCastingList.Top = .TxbCasting.Top + .TxbCasting.Height + 5
        .OptionCastingList.Top = .TxbCastingList.Top + 2
    End With
    With objForm
        With .TxbCastingList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblMaquillageCoiffure.Top = .TxbCastingList.Top + .TxbCastingList.Height + 5
        .TxbMaquillageCoiffure.Top = .LblMaquillageCoiffure.Top + .LblMaquillageCoiffure.Height + 5
        .OptionMaquillageCoiffure.Top = .TxbMaquillageCoiffure.Top + 2
        '-----
        .TxbMaquillageCoiffureList.Top = .TxbMaquillageCoiffure.Top + .TxbMaquillageCoiffure.Height + 5
        .OptionMaquillageCoiffureList.Top = .TxbMaquillageCoiffureList.Top + 2
    End With
    With objForm
        With .TxbMaquillageCoiffureList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblDirectionArtistique.Top = .TxbMaquillageCoiffureList.Top + .TxbMaquillageCoiffureList.Height + 5
        .TxbDirectionArtistique.Top = .LblDirectionArtistique.Top + .LblDirectionArtistique.Height + 5
        .OptionDirectionArtistique.Top = .TxbDirectionArtistique.Top + 2
        '-----
        .TxbDirectionArtistiqueList.Top = .TxbDirectionArtistique.Top + .TxbDirectionArtistique.Height + 5
        .OptionDirectionArtistiqueList.Top = .TxbDirectionArtistiqueList.Top + 2
    End With
    With objForm
        With .TxbDirectionArtistiqueList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblChefDecoration.Top = .TxbDirectionArtistiqueList.Top + .TxbDirectionArtistiqueList.Height + 5
        .TxbChefDecoration.Top = .LblChefDecoration.Top + .LblChefDecoration.Height + 5
        .OptionChefDecoration.Top = .TxbChefDecoration.Top + 2
        '-----
        .TxbChefDecorationList.Top = .TxbChefDecoration.Top + .TxbChefDecoration.Height + 5
        .OptionChefDecorationList.Top = .TxbChefDecorationList.Top + 2
    End With
    With objForm
        With .TxbChefDecorationList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblAssistantRealisation.Top = .TxbChefDecorationList.Top + .TxbChefDecorationList.Height + 5
        .TxbAssistantRealisation.Top = .LblAssistantRealisation.Top + .LblAssistantRealisation.Height + 5
        .OptionAssistantRealisation.Top = .TxbAssistantRealisation.Top + 2
        '-----
        .TxbAssistantRealisationList.Top = .TxbAssistantRealisation.Top + .TxbAssistantRealisation.Height + 5
        .OptionAssistantRealisationList.Top = .TxbAssistantRealisationList.Top + 2
    End With
    With objForm
        With .TxbAssistantRealisationList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblSon.Top = .TxbAssistantRealisationList.Top + .TxbAssistantRealisationList.Height + 5
        .TxbSon.Top = .LblSon.Top + .LblSon.Height + 5
        .OptionSon.Top = .TxbSon.Top + 2
        '-----
        .TxbSonList.Top = .TxbSon.Top + .TxbSon.Height + 5
        .OptionSonList.Top = .TxbSonList.Top + 2
    End With
    With objForm
        With .TxbSonList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblEffetsSpeciaux.Top = .TxbSonList.Top + .TxbSonList.Height + 5
        .TxbEffetsSpeciaux.Top = .LblEffetsSpeciaux.Top + .LblEffetsSpeciaux.Height + 5
        .OptionEffetsSpeciaux.Top = .TxbEffetsSpeciaux.Top + 2
        '-----
        .TxbEffetsSpeciauxList.Top = .TxbEffetsSpeciaux.Top + .TxbEffetsSpeciaux.Height + 5
        .OptionEffetsSpeciauxList.Top = .TxbEffetsSpeciauxList.Top + 2
    End With
    With objForm
        With .TxbEffetsSpeciauxList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .LblDirectionProduction.Top = .TxbEffetsSpeciauxList.Top + .TxbEffetsSpeciauxList.Height + 5
        .TxbDirectionProduction.Top = .LblDirectionProduction.Top + .LblDirectionProduction.Height + 5
        .OptionDirectionProduction.Top = .TxbDirectionProduction.Top + 2
        '-----
        .TxbDirectionProductionList.Top = .TxbDirectionProduction.Top + .TxbDirectionProduction.Height + 5
        .OptionDirectionProductionList.Top = .TxbDirectionProductionList.Top + 2
    End With
    With objForm
        With .TxbDirectionProductionList
            .Value = ""
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
    End With
    With objForm
        .FrmExtraireData.ScrollHeight = .TxbDirectionProductionList.Top + .TxbDirectionProductionList.Height + 5
        .FrmExtraireData.ScrollTop = 0
        .FrmData.Height = .FrmExtraireData.ScrollHeight
    End With
    FormDataWebFilm_IsChangeInProgress = False
End Sub

aprés les "cases" jaunes , effacer les "cases" gris clair avec : Call DataFilmWebEfface(objFormDataWebFilm)
on pourrait penser que le code est identique ... mais non

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
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
 
Public Sub DataFilmWebEfface(objForm As Object)
    FormDataWebFilm_IsChangeInProgress = True
    With objForm
        .TxbTitre.Value = ""
        .TxbAlias.Value = ""
        .TxbAnnee.Value = ""
        .TxbGenre.Value = ""
    End With
    With objForm
        With .TxbResume
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbResumeList.Top = .TxbResume.Top + .TxbResume.Height + 5
        .OptionResumeList.Top = .TxbResumeList.Top + 2
    End With
    With objForm
        .LblRealisateur.Top = .TxbResumeList.Top + .TxbResumeList.Height + 5
        .TxbRealisateur.Top = .LblRealisateur.Top + .LblRealisateur.Height + 5
        .OptionRealisateur.Top = .TxbRealisateur.Top + 2
        With .TxbRealisateur
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbRealisateurList.Top = .TxbRealisateur.Top + .TxbRealisateur.Height + 5
        .OptionRealisateurList.Top = .TxbRealisateurList.Top + 2
    End With
 
    With objForm
        .LblActeur.Top = .TxbRealisateurList.Top + .TxbRealisateurList.Height + 5
        .TxbActeur.Top = .LblActeur.Top + .LblActeur.Height + 5
        .OptionActeur.Top = .TxbActeur.Top + 2
        With .TxbActeur
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbActeurList.Top = .TxbActeur.Top + .TxbActeur.Height + 5
        .OptionActeurList.Top = .TxbActeurList.Top + 2
    End With
    With objForm
        .LblEcriture.Top = .TxbActeurList.Top + .TxbActeurList.Height + 5
        .TxbEcriture.Top = .LblEcriture.Top + .LblEcriture.Height + 5
        .OptionEcriture.Top = .TxbEcriture.Top + 2
        '-----
        With .TxbEcriture
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbEcritureList.Top = .TxbEcriture.Top + .TxbEcriture.Height + 5
        .OptionEcritureList.Top = .TxbEcritureList.Top + 2
    End With
    With objForm
        .LblProduction.Top = .TxbEcritureList.Top + .TxbEcritureList.Height + 5
        .TxbProduction.Top = .LblProduction.Top + .LblProduction.Height + 5
        .OptionProduction.Top = .TxbProduction.Top + 2
        With .TxbProduction
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbProductionList.Top = .TxbProduction.Top + .TxbProduction.Height + 5
        .OptionProductionList.Top = .TxbProductionList.Top + 2
    End With
    With objForm
        .LblMontage.Top = .TxbProductionList.Top + .TxbProductionList.Height + 5
        .TxbMontage.Top = .LblMontage.Top + .LblMontage.Height + 5
        .OptionMontage.Top = .TxbMontage.Top + 2
        With .TxbMontage
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbMontageList.Top = .TxbMontage.Top + .TxbMontage.Height + 5
        .OptionMontageList.Top = .TxbMontageList.Top + 2
    End With
    With objForm
        .LblPhotographie.Top = .TxbMontageList.Top + .TxbMontageList.Height + 5
        .TxbPhotographie.Top = .LblPhotographie.Top + .LblPhotographie.Height + 5
        .OptionPhotographie.Top = .TxbPhotographie.Top + 2
        With .TxbPhotographie
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbPhotographieList.Top = .TxbPhotographie.Top + .TxbPhotographie.Height + 5
        .OptionPhotographieList.Top = .TxbPhotographieList.Top + 2
    End With
    With objForm
        .LblMusique.Top = .TxbPhotographieList.Top + .TxbPhotographieList.Height + 5
        .TxbMusique.Top = .LblMusique.Top + .LblMusique.Height + 5
        .OptionMusique.Top = .TxbMusique.Top + 2
        With .TxbMusique
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbMusiqueList.Top = .TxbMusique.Top + .TxbMusique.Height + 5
        .OptionMusiqueList.Top = .TxbMusiqueList.Top + 2
    End With
    With objForm
        .LblCostume.Top = .TxbMusiqueList.Top + .TxbMusiqueList.Height + 5
        .TxbCostume.Top = .LblCostume.Top + .LblCostume.Height + 5
        .OptionCostume.Top = .TxbCostume.Top + 2
        With .TxbCostume
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbCostumeList.Top = .TxbCostume.Top + .TxbCostume.Height + 5
        .OptionCostumeList.Top = .TxbCostumeList.Top + 2
    End With
    With objForm
        .LblDecor.Top = .TxbCostumeList.Top + .TxbCostumeList.Height + 5
        .TxbDecor.Top = .LblDecor.Top + .LblDecor.Height + 5
        .OptionDecor.Top = .TxbDecor.Top + 2
        With .TxbDecor
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbDecorList.Top = .TxbDecor.Top + .TxbDecor.Height + 5
        .OptionDecorList.Top = .TxbDecorList.Top + 2
    End With
    With objForm
        .LblCasting.Top = .TxbDecorList.Top + .TxbDecorList.Height + 5
        .TxbCasting.Top = .LblCasting.Top + .LblCasting.Height + 5
        .OptionCasting.Top = .TxbCasting.Top + 2
        With .TxbCasting
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbCastingList.Top = .TxbCasting.Top + .TxbCasting.Height + 5
        .OptionCastingList.Top = .TxbCastingList.Top + 2
    End With
    With objForm
        .LblMaquillageCoiffure.Top = .TxbCastingList.Top + .TxbCastingList.Height + 5
        .TxbMaquillageCoiffure.Top = .LblMaquillageCoiffure.Top + .LblMaquillageCoiffure.Height + 5
        .OptionMaquillageCoiffure.Top = .TxbMaquillageCoiffure.Top + 2
        With .TxbMaquillageCoiffure
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbMaquillageCoiffureList.Top = .TxbMaquillageCoiffure.Top + .TxbMaquillageCoiffure.Height + 5
        .OptionMaquillageCoiffureList.Top = .TxbMaquillageCoiffureList.Top + 2
    End With
    With objForm
        .LblDirectionArtistique.Top = .TxbMaquillageCoiffureList.Top + .TxbMaquillageCoiffureList.Height + 5
        .TxbDirectionArtistique.Top = .LblDirectionArtistique.Top + .LblDirectionArtistique.Height + 5
        .OptionDirectionArtistique.Top = .TxbDirectionArtistique.Top + 2
        With .TxbDirectionArtistique
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbDirectionArtistiqueList.Top = .TxbDirectionArtistique.Top + .TxbDirectionArtistique.Height + 5
        .OptionDirectionArtistiqueList.Top = .TxbDirectionArtistiqueList.Top + 2
    End With
    With objForm
        .LblChefDecoration.Top = .TxbDirectionArtistiqueList.Top + .TxbDirectionArtistiqueList.Height + 5
        .TxbChefDecoration.Top = .LblChefDecoration.Top + .LblChefDecoration.Height + 5
        .OptionChefDecoration.Top = .TxbChefDecoration.Top + 2
        With .TxbChefDecoration
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbChefDecorationList.Top = .TxbChefDecoration.Top + .TxbChefDecoration.Height + 5
        .OptionChefDecorationList.Top = .TxbChefDecorationList.Top + 2
    End With
    With objForm
        .LblAssistantRealisation.Top = .TxbChefDecorationList.Top + .TxbChefDecorationList.Height + 5
        .TxbAssistantRealisation.Top = .LblAssistantRealisation.Top + .LblAssistantRealisation.Height + 5
        .OptionAssistantRealisation.Top = .TxbAssistantRealisation.Top + 2
        With .TxbAssistantRealisation
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbAssistantRealisationList.Top = .TxbAssistantRealisation.Top + .TxbAssistantRealisation.Height + 5
        .OptionAssistantRealisationList.Top = .TxbAssistantRealisationList.Top + 2
    End With
    With objForm
        .LblSon.Top = .TxbAssistantRealisationList.Top + .TxbAssistantRealisationList.Height + 5
        .TxbSon.Top = .LblSon.Top + .LblSon.Height + 5
        .OptionSon.Top = .TxbSon.Top + 2
        With .TxbSon
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbSonList.Top = .TxbSon.Top + .TxbSon.Height + 5
        .OptionSonList.Top = .TxbSonList.Top + 2
    End With
    With objForm
        .LblEffetsSpeciaux.Top = .TxbSonList.Top + .TxbSonList.Height + 5
        .TxbEffetsSpeciaux.Top = .LblEffetsSpeciaux.Top + .LblEffetsSpeciaux.Height + 5
        .OptionEffetsSpeciaux.Top = .TxbEffetsSpeciaux.Top + 2
        With .TxbEffetsSpeciaux
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbEffetsSpeciauxList.Top = .TxbEffetsSpeciaux.Top + .TxbEffetsSpeciaux.Height + 5
        .OptionEffetsSpeciauxList.Top = .TxbEffetsSpeciauxList.Top + 2
    End With
    With objForm
        .LblDirectionProduction.Top = .TxbEffetsSpeciauxList.Top + .TxbEffetsSpeciauxList.Height + 5
        .TxbDirectionProduction.Top = .LblDirectionProduction.Top + .LblDirectionProduction.Height + 5
        .OptionDirectionProduction.Top = .TxbDirectionProduction.Top + 2
        With .TxbDirectionProduction
            .Value = ""
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            .Height = 14
        End With
        .TxbDirectionProductionList.Top = .TxbDirectionProduction.Top + .TxbDirectionProduction.Height + 5
        .OptionDirectionProductionList.Top = .TxbDirectionProductionList.Top + 2
    End With
    With objForm
        .FrmExtraireData.ScrollHeight = .TxbDirectionProductionList.Top + .TxbDirectionProductionList.Height + 5
        .FrmExtraireData.ScrollTop = 0
        .FrmData.Height = .FrmExtraireData.ScrollHeight
    End With
    FormDataWebFilm_IsChangeInProgress = False
End Sub

[mjpmjp]

Bonjour,

nous voila avec une page bien propre , bien ordonnée ...
on peut donc charger et écrire les Data stockés dans le PC avec :
Call DataFilmListLire(objFormDataWebFilm, ActiveSheet.Name, ListLigneSelected)

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
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
 
Public DataSheetList As String
Public DataLigneList As Single
Public Sub DataFilmListLire(objForm As Object, ByVal SheetName As String, ByVal Ligne As Single)
    FormDataWebFilm_IsChangeInProgress = True
    DataSheetList = SheetName
    DataLigneList = Ligne
    With objForm.TxbTitreList
        .Value = Sheets(SheetName).Cells(Ligne, ListColonNumTitre).Value
    End With
    With objForm.TxbAliasList
        .Value = Sheets(SheetName).Cells(Ligne, ListColonNumAlias).Value
        If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
    End With
    With objForm.TxbAnneeList
        .Value = Sheets(SheetName).Cells(Ligne, ListColonNumAnnee).Value
    End With
    With objForm.TxbGenreList
        .Value = Sheets(SheetName).Cells(Ligne, ListColonNumGenre).Value
    End With
    With objForm
        With .TxbResumeList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumResume).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            ''.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblRealisateur.Top = .TxbResumeList.Top + .TxbResumeList.Height + 5
        .TxbRealisateur.Top = .LblRealisateur.Top + .LblRealisateur.Height + 5
        .OptionRealisateur.Top = .TxbRealisateur.Top + 2
        '-----
        .TxbRealisateurList.Top = .TxbRealisateur.Top + .TxbRealisateur.Height + 5
        .OptionRealisateurList.Top = .TxbRealisateurList.Top + 2
    End With
    With objForm
        With .TxbRealisateurList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumRealisateur).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblActeur.Top = .TxbRealisateurList.Top + .TxbRealisateurList.Height + 5
        .TxbActeur.Top = .LblActeur.Top + .LblActeur.Height + 5
        .OptionActeur.Top = .TxbActeur.Top + 2
        '-----
        .TxbActeurList.Top = .TxbActeur.Top + .TxbActeur.Height + 5
        .OptionActeurList.Top = .TxbActeurList.Top + 2
    End With
    With objForm
        With .TxbActeurList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumActeur).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblEcriture.Top = .TxbActeurList.Top + .TxbActeurList.Height + 5
        .TxbEcriture.Top = .LblEcriture.Top + .LblEcriture.Height + 5
        .OptionEcriture.Top = .TxbEcriture.Top + 2
        '-----
        .TxbEcritureList.Top = .TxbEcriture.Top + .TxbEcriture.Height + 5
        .OptionEcritureList.Top = .TxbEcritureList.Top + 2
    End With
    With objForm
        With .TxbEcritureList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumEcriture).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblProduction.Top = .TxbEcritureList.Top + .TxbEcritureList.Height + 5
        .TxbProduction.Top = .LblProduction.Top + .LblProduction.Height + 5
        .OptionProduction.Top = .TxbProduction.Top + 2
        '-----
        .TxbProductionList.Top = .TxbProduction.Top + .TxbProduction.Height + 5
        .OptionProductionList.Top = .TxbProductionList.Top + 2
    End With
    With objForm
        With .TxbProductionList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumProduction).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblMontage.Top = .TxbProductionList.Top + .TxbProductionList.Height + 5
        .TxbMontage.Top = .LblMontage.Top + .LblMontage.Height + 5
        .OptionMontage.Top = .TxbMontage.Top + 2
        '-----
        .TxbMontageList.Top = .TxbMontage.Top + .TxbMontage.Height + 5
        .OptionMontageList.Top = .TxbMontageList.Top + 2
    End With
    With objForm
        With .TxbMontageList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumMontage).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblPhotographie.Top = .TxbMontageList.Top + .TxbMontageList.Height + 5
        .TxbPhotographie.Top = .LblPhotographie.Top + .LblPhotographie.Height + 5
        .OptionPhotographie.Top = .TxbPhotographie.Top + 2
        '-----
        .TxbPhotographieList.Top = .TxbPhotographie.Top + .TxbPhotographie.Height + 5
        .OptionPhotographieList.Top = .TxbPhotographieList.Top + 2
    End With
    With objForm
        With .TxbPhotographieList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumPhotographie).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblMusique.Top = .TxbPhotographieList.Top + .TxbPhotographieList.Height + 5
        .TxbMusique.Top = .LblMusique.Top + .LblMusique.Height + 5
        .OptionMusique.Top = .TxbMusique.Top + 2
        '-----
        .TxbMusiqueList.Top = .TxbMusique.Top + .TxbMusique.Height + 5
        .OptionMusiqueList.Top = .TxbMusiqueList.Top + 2
    End With
    With objForm
        With .TxbMusiqueList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumMusique).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        '-----
        .LblCostume.Top = .TxbMusiqueList.Top + .TxbMusiqueList.Height + 5
        .TxbCostume.Top = .LblCostume.Top + .LblCostume.Height + 5
        .OptionCostume.Top = .TxbCostume.Top + 2
        '-----
        .TxbCostumeList.Top = .TxbCostume.Top + .TxbCostume.Height + 5
        .OptionCostumeList.Top = .TxbCostumeList.Top + 2
    End With
    With objForm
        With .TxbCostumeList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumCostume).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblDecor.Top = .TxbCostumeList.Top + .TxbCostumeList.Height + 5
        .TxbDecor.Top = .LblDecor.Top + .LblDecor.Height + 5
        .OptionDecor.Top = .TxbDecor.Top + 2
        '-----
        .TxbDecorList.Top = .TxbDecor.Top + .TxbDecor.Height + 5
        .OptionDecorList.Top = .TxbDecorList.Top + 2
    End With
    With objForm
        With .TxbDecorList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumDecor).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblCasting.Top = .TxbDecorList.Top + .TxbDecorList.Height + 5
        .TxbCasting.Top = .LblCasting.Top + .LblCasting.Height + 5
        .OptionCasting.Top = .TxbCasting.Top + 2
        '-----
        .TxbCastingList.Top = .TxbCasting.Top + .TxbCasting.Height + 5
        .OptionCastingList.Top = .TxbCastingList.Top + 2
    End With
    With objForm
        With .TxbCastingList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumCasting).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblMaquillageCoiffure.Top = .TxbCastingList.Top + .TxbCastingList.Height + 5
        .TxbMaquillageCoiffure.Top = .LblMaquillageCoiffure.Top + .LblMaquillageCoiffure.Height + 5
        .OptionMaquillageCoiffure.Top = .TxbMaquillageCoiffure.Top + 2
        '-----
        .TxbMaquillageCoiffureList.Top = .TxbMaquillageCoiffure.Top + .TxbMaquillageCoiffure.Height + 5
        .OptionMaquillageCoiffureList.Top = .TxbMaquillageCoiffureList.Top + 2
    End With
    With objForm
        With .TxbMaquillageCoiffureList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumMaquillageCoiffure).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblDirectionArtistique.Top = .TxbMaquillageCoiffureList.Top + .TxbMaquillageCoiffureList.Height + 5
        .TxbDirectionArtistique.Top = .LblDirectionArtistique.Top + .LblDirectionArtistique.Height + 5
        .OptionDirectionArtistique.Top = .TxbDirectionArtistique.Top + 2
        '-----
        .TxbDirectionArtistiqueList.Top = .TxbDirectionArtistique.Top + .TxbDirectionArtistique.Height + 5
        .OptionDirectionArtistiqueList.Top = .TxbDirectionArtistiqueList.Top + 2
    End With
    With objForm
        With .TxbDirectionArtistiqueList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumDirectionArtistique).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblChefDecoration.Top = .TxbDirectionArtistiqueList.Top + .TxbDirectionArtistiqueList.Height + 5
        .TxbChefDecoration.Top = .LblChefDecoration.Top + .LblChefDecoration.Height + 5
        .OptionChefDecoration.Top = .TxbChefDecoration.Top + 2
        '-----
        .TxbChefDecorationList.Top = .TxbChefDecoration.Top + .TxbChefDecoration.Height + 5
        .OptionChefDecorationList.Top = .TxbChefDecorationList.Top + 2
    End With
    With objForm
        With .TxbChefDecorationList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumChefDecoration).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblAssistantRealisation.Top = .TxbChefDecorationList.Top + .TxbChefDecorationList.Height + 5
        .TxbAssistantRealisation.Top = .LblAssistantRealisation.Top + .LblAssistantRealisation.Height + 5
        .OptionAssistantRealisation.Top = .TxbAssistantRealisation.Top + 2
        '-----
        .TxbAssistantRealisationList.Top = .TxbAssistantRealisation.Top + .TxbAssistantRealisation.Height + 5
        .OptionAssistantRealisationList.Top = .TxbAssistantRealisationList.Top + 2
    End With
    With objForm
        With .TxbAssistantRealisationList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumAssistantRealisation).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblSon.Top = .TxbAssistantRealisationList.Top + .TxbAssistantRealisationList.Height + 5
        .TxbSon.Top = .LblSon.Top + .LblSon.Height + 5
        .OptionSon.Top = .TxbSon.Top + 2
        '-----
        .TxbSonList.Top = .TxbSon.Top + .TxbSon.Height + 5
        .OptionSonList.Top = .TxbSonList.Top + 2
    End With
    With objForm
        With .TxbSonList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumSon).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblEffetsSpeciaux.Top = .TxbSonList.Top + .TxbSonList.Height + 5
        .TxbEffetsSpeciaux.Top = .LblEffetsSpeciaux.Top + .LblEffetsSpeciaux.Height + 5
        .OptionEffetsSpeciaux.Top = .TxbEffetsSpeciaux.Top + 2
        '-----
        .TxbEffetsSpeciauxList.Top = .TxbEffetsSpeciaux.Top + .TxbEffetsSpeciaux.Height + 5
        .OptionEffetsSpeciauxList.Top = .TxbEffetsSpeciauxList.Top + 2
    End With
    With objForm
        With .TxbEffetsSpeciauxList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumEffetsSpeciaux).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
        .LblDirectionProduction.Top = .TxbEffetsSpeciauxList.Top + .TxbEffetsSpeciauxList.Height + 5
        .TxbDirectionProduction.Top = .LblDirectionProduction.Top + .LblDirectionProduction.Height + 5
        .OptionDirectionProduction.Top = .TxbDirectionProduction.Top + 2
        '-----
        .TxbDirectionProductionList.Top = .TxbDirectionProduction.Top + .TxbDirectionProduction.Height + 5
        .OptionDirectionProductionList.Top = .TxbDirectionProductionList.Top + 2
    End With
    With objForm
        With .TxbDirectionProductionList
            .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumDirectionProduction).Value)
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
            .Width = 490
            '.Font = "Tahoma"
            .Font.Size = "8"
            '-----
            .SetFocus
            If .LineCount > 1 Then
                .Height = (.Font.Size + 4) * .LineCount
            Else
                .Height = 14
            End If
        End With
    End With
    With objForm
        .FrmExtraireData.ScrollHeight = .TxbDirectionProductionList.Top + .TxbDirectionProductionList.Height + 5
        .FrmExtraireData.ScrollTop = 0
        .FrmData.Height = .FrmExtraireData.ScrollHeight
    End With
    FormDataWebFilm_IsChangeInProgress = False
End Sub

à ce stade , le code a écrit dans les "cases" jaunes , les "cases" gris clair sont vides et tout est ordonné ,
l'appel à : Call DataFilmWebOption(objFormDataWebFilm) va gérer les "OptionButton" (bouton radio)...
le code va comparer la longueur du contenu des "cases" jaunes et gris clair et va activer l' "OptionButton" pour les arbitrages supérieurs

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
 
Public Sub DataFilmWebOption(objForm As Object)
    FormDataWebFilm_IsChangeInProgress = True
    With objForm
        .OptionTitreList.Value = True
        .OptionAliasList.Value = True
        .OptionAnneeList.Value = True
        .OptionGenreList.Value = True
        .OptionResumeList.Value = True
        .OptionRealisateurList.Value = True
        .OptionActeurList.Value = True
        .OptionEcritureList.Value = True
        .OptionProductionList.Value = True
        .OptionMontageList.Value = True
        .OptionPhotographieList.Value = True
        .OptionMusiqueList.Value = True
        .OptionCostumeList.Value = True
        .OptionDecorList.Value = True
        .OptionCastingList.Value = True
        .OptionMaquillageCoiffureList.Value = True
        .OptionDirectionArtistiqueList.Value = True
        .OptionChefDecorationList.Value = True
        .OptionAssistantRealisationList.Value = True
        .OptionSonList.Value = True
        .OptionEffetsSpeciauxList.Value = True
        .OptionDirectionProductionList.Value = True
    End With
    With objForm
        If Len(.TxbTitre.Value) > Len(.TxbTitreList) Then .OptionTitre.Value = True
        If Len(.TxbAlias.Value) > Len(.TxbAliasList) Then .OptionAlias.Value = True
        If Len(.TxbAnnee.Value) > Len(.TxbAnneeList) Then .OptionAnnee.Value = True
        'If Len(.TxbGenre.Value) > Len(.TxbGenreList) Then .OptionGenre.Value = True
        If Len(.TxbResume.Value) > Len(.TxbResumeList) Then .OptionResume.Value = True
        If Len(.TxbRealisateur.Value) > Len(.TxbRealisateurList) Then .OptionRealisateur.Value = True
        If Len(.TxbActeur.Value) > Len(.TxbActeurList) Then .OptionActeur.Value = True
        If Len(.TxbEcriture.Value) > Len(.TxbEcritureList) Then .OptionEcriture.Value = True
        If Len(.TxbProduction.Value) > Len(.TxbProductionList) Then .OptionProduction.Value = True
        If Len(.TxbMontage.Value) > Len(.TxbMontageList) Then .OptionMontage.Value = True
        If Len(.TxbPhotographie.Value) > Len(.TxbPhotographieList) Then .OptionPhotographie.Value = True
        If Len(.TxbMusique.Value) > Len(.TxbMusiqueList) Then .OptionMusique.Value = True
        If Len(.TxbCostume.Value) > Len(.TxbCostumeList) Then .OptionCostume.Value = True
        If Len(.TxbDecor.Value) > Len(.TxbDecorList) Then .OptionDecor.Value = True
        If Len(.TxbCasting.Value) > Len(.TxbCastingList) Then .OptionCasting.Value = True
        If Len(.TxbMaquillageCoiffure.Value) > Len(.TxbMaquillageCoiffureList) Then .OptionMaquillageCoiffure.Value = True
        If Len(.TxbDirectionArtistique.Value) > Len(.TxbDirectionArtistiqueList) Then .OptionDirectionArtistique.Value = True
        If Len(.TxbChefDecoration.Value) > Len(.TxbChefDecorationList) Then .OptionChefDecoration.Value = True
        If Len(.TxbAssistantRealisation.Value) > Len(.TxbAssistantRealisationList) Then .OptionAssistantRealisation.Value = True
        If Len(.TxbSon.Value) > Len(.TxbSonList) Then .OptionSon.Value = True
        If Len(.TxbEffetsSpeciaux.Value) > Len(.TxbEffetsSpeciauxList) Then .OptionEffetsSpeciaux.Value = True
        If Len(.TxbDirectionProduction.Value) > Len(.TxbDirectionProductionList) Then .OptionDirectionProduction.Value = True
    End With
    FormDataWebFilm_IsChangeInProgress = False
End Sub

voila pour cette première partie qui consiste à charger les Data du PC ,



voila une autre vue avec l'ajustement des "cases"



maintenant il faut aller chercher les Data sur le Web...

[mjpmjp]

Bonjour,

je remet le code du bouton Extraire (action)... action pour ne pas confondre avec le bouton Extraire qui active la frame FrmExtraire

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
 
'===================================================================== Extraire
'------------------------------------------------------- Btn Extraire
Private Sub LblExtraire_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblExtraire.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub LblExtraire_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.LblExtraire.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub LblExtraire_Click()
    If Me.LblExtraire.BackColor = &H80000002 Then
        'ferme
        Me.LblExtraire.BackColor = &H8000000F 'normal
    Else
        'ouvre
        Me.LblExtraire.BackColor = &H80000002 'actif
        'action
        FormDataWebFilm_IsChangeInProgress = True
        '-----
        Call DataFilmWebExtraire(objFormDataWebFilm)
        Call DataFilmWebOrganiser
        Call DataFilmWebEfface(objFormDataWebFilm)
        Call DataFilmWebLire(objFormDataWebFilm)
        Call DataFilmWebOption(objFormDataWebFilm)
        '----- efface affiche
        Call AfficheFormEffaceWeb(objFormDataWebFilm)
        Call DataFilmAfficheWeb(objFormDataWebFilm)
        Call AffichesPageWeb(objFormDataWebFilm)
        '-----
        FormDataWebFilm_IsChangeInProgress = False
        'bouton
        Me.LblExtraire.BackColor = &H8000000F 'normal
    End If
End Sub

donc , on commence par extraire les "DataWeb" avec : Call DataFilmWebExtraire(objFormDataWebFilm)

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
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
 
Public objWB As SHDocVw.WebBrowser
Public objDoc As MSHTML.HTMLDocument
Public TabDataHTML() As String
Public TabDataFilm() As String
Public Sub DataFilmWebExtraire(objForm As Object)
    'dimensionne et efface
    ReDim TabDataHTML(2000)
    ReDim TabDataFilm(1000)
    '-----
    'READYSTATE_UNINITIALIZED = 0
    'READYSTATE_LOADING = 1
    'READYSTATE_LOADED = 2
    'READYSTATE_INTERACTIVE = 3
    'READYSTATE_COMPLETE = 4
    'On boucle tant que la page n'est pas totalement chargée
    'pTimeOut est un time out en secondes (WaitIE vaut True si Timeout)
    Dim lTimer As Double
    lTimer = Timer
    pTimeOut = 2
    Do
        DoEvents
        If objWB.readyState = READYSTATE_COMPLETE And Not objWB.Busy Then Exit Do
        If pTimeOut > 0 And Timer - lTimer > pTimeOut Then Exit Do
    Loop
    '-----
    ' Page chargée, on continue
    Set objDoc = objWB.document
    '-----
    Ligne = 1
    Set DataH = objDoc.getElementsByTagName("head")
    For n = 1 To DataH(0).all.Length - 1
        TabDataHTML(Ligne) = DataH(0).all(n).outerHTML
        Ligne = Ligne + 1
    Next n
    Set DataTab = objDoc.getElementsByTagName("table")
    For n = 1 To DataTab.Length - 1
        Set DataTD = DataTab(n).getElementsByTagName("td")
        For n2 = 1 To DataTD.Length - 1
            TabDataHTML(Ligne) = DataTD(n2).innerHTML
            Ligne = Ligne + 1
        Next n2
    Next n
    '-----
    Ligne = 0
    'LigneFin = Range("b" & Rows.Count).End(xlUp).Row
    LigneFin = UBound(TabDataHTML)
    '----- description
    DataElement = objDoc.getElementsByName("description")
    TabElement = Split(DataElement.Content, "-")
    '-----
    If InStr(TabElement(0), "(") > 0 Then
        Titre = Trim(FormatTitre(Split(TabElement(0), "(")(0)))
        Alias = Trim(FormatTitre(Replace(Split(TabElement(0), "(")(1), ")", "")))
    Else
        Titre = Trim(FormatTitre(TabElement(0)))
        Alias = ""
    End If
    'titre
    DataLigne = "Titre"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Trim(TabElement(0))
    DataLigne = DataLigne & "|" & Titre
    Ligne = 1: TabDataFilm(Ligne) = DataLigne
    'alias
    DataLigne = "Alias"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Trim(TabElement(0))
    DataLigne = DataLigne & "|" & Alias
    Ligne = 2: TabDataFilm(Ligne) = DataLigne
    'année
    DataLigne = "Année"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Trim(TabElement(1))
    DataLigne = DataLigne & "|" & Trim(TabElement(1))
    Ligne = 3: TabDataFilm(Ligne) = DataLigne
    'genre
    If InStr(LCase(TabElement(2)), "science") > 0 Then
        DataGenre = "Science-Fiction"
    Else
        DataGenre = Trim(TabElement(2))
    End If
    DataLigne = "Genre"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Trim(TabElement(2))
    DataLigne = DataLigne & "|" & DataGenre
    Ligne = 4: TabDataFilm(Ligne) = DataLigne
    'résumé / synopsis
    Set DataSpan = objDoc.getElementsByTagName("span")
    For n = 1 To 200
        If InStr(LCase(DataSpan(n).outerHTML), "description") > 0 Then
            DataResume = Trim(Replace(Replace(DataSpan(n).outerText, vbCrLf, ""), "|", ":"))
            Exit For
        End If
    Next n
    DataLigne = "Résumé"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & DataSpan(n).outerText
    DataLigne = DataLigne & "|" & DataResume
    Ligne = 5: TabDataFilm(Ligne) = DataLigne
    '-----
    'réalisation
    DataLigne = "Réalisateur"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 6: TabDataFilm(Ligne) = DataLigne
    'interprétation
    DataLigne = "Acteur"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 7: TabDataFilm(Ligne) = DataLigne
    'ecriture
    DataLigne = "Ecriture"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 8: TabDataFilm(Ligne) = DataLigne
    'production
    DataLigne = "Production"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 9: TabDataFilm(Ligne) = DataLigne
    'montage
    DataLigne = "Montage"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 10: TabDataFilm(Ligne) = DataLigne
    'photographie
    DataLigne = "Photographie"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 11: TabDataFilm(Ligne) = DataLigne
    'musique
    DataLigne = "Musique"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 12: TabDataFilm(Ligne) = DataLigne
    'costumes
    DataLigne = "Costumes"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 13: TabDataFilm(Ligne) = DataLigne
    'décors
    DataLigne = "Décors"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 14: TabDataFilm(Ligne) = DataLigne
    'casting
    DataLigne = "Casting"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 15: TabDataFilm(Ligne) = DataLigne
    'maquillage_coiffure
    DataLigne = "Maquillage_Coiffure"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 16: TabDataFilm(Ligne) = DataLigne
    'direction artistique
    DataLigne = "Direction Artistique"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 17: TabDataFilm(Ligne) = DataLigne
    'chef décoration
    DataLigne = "Chef Décoration"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 18: TabDataFilm(Ligne) = DataLigne
    'assistant réalisation
    DataLigne = "Assistant Réalisation"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 19: TabDataFilm(Ligne) = DataLigne
    'son
    DataLigne = "Son"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 20: TabDataFilm(Ligne) = DataLigne
    'effets spéciaux
    DataLigne = "Effets Spéciaux"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 21: TabDataFilm(Ligne) = DataLigne
    'direction de production
    DataLigne = "Direction Production"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 22: TabDataFilm(Ligne) = DataLigne
    'durée
    DataLigne = "Durée"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
    Ligne = 23: TabDataFilm(Ligne) = DataLigne
    'CD Total
    DataLigne = "CD Total"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
    Ligne = 24: TabDataFilm(Ligne) = DataLigne
    'CD1
    DataLigne = "CD1"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
    Ligne = 25: TabDataFilm(Ligne) = DataLigne
    'CD2
    DataLigne = "CD2"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
    Ligne = 26: TabDataFilm(Ligne) = DataLigne
    'CD3
    DataLigne = "CD3"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
    Ligne = 27: TabDataFilm(Ligne) = DataLigne
    'CD4
    DataLigne = "CD4"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
    Ligne = 28: TabDataFilm(Ligne) = DataLigne
    'CD5
    DataLigne = "CD5"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
    Ligne = 29: TabDataFilm(Ligne) = DataLigne
    'CD6
    DataLigne = "CD6"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
    Ligne = 30: TabDataFilm(Ligne) = DataLigne
    'NOTE
    DataLigne = "NOTE"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
    Ligne = 31: TabDataFilm(Ligne) = DataLigne
    'vide
    DataLigne = "vide29"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 32: TabDataFilm(Ligne) = DataLigne
    'vide
    DataLigne = "vide30"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 33: TabDataFilm(Ligne) = DataLigne
    '-----
    LinkNum = objDoc.Links.Length - 1
    If LinkNum > 0 Then
        For n = 0 To LinkNum
            If InStr(LCase(objDoc.Links(n)), "/affiche") > 0 Then
                'lien affiche 1
                LienAffiche = Replace(objDoc.Links(n), "http://", "")
                Exit For
            End If
        Next n
        For n2 = 0 To LinkNum
            If InStr(LCase(objDoc.Links(n2)), "/photos/") > 0 Then
                'lien page film
                LienPageFilm = Replace(Split(objDoc.Links(n2), "/photos/")(0), "http://", "")
                Exit For
            ElseIf InStr(LCase(objDoc.Links(n2)), "#distribution-complete") > 0 Then
                'lien page film
                LienPageFilm = Replace(Split(objDoc.Links(n2), "#distribution-complete")(0), "http://", "")
                Exit For
            End If
        Next n2
        For n3 = 0 To LinkNum
            If InStr(LCase(objDoc.Links(n3)), "/affiches") > 0 Then
                'lien page affiches
                LienPageAffiches = Replace(objDoc.Links(n3), "http://", "")
                'nombre affiches
                NombreAffiches = Split(Split(objDoc.Links(n3).innerText, "(")(1), ")")(0)
                Exit For
            End If
        Next n3
    End If
    'nombre affiches
    DataLigne = "Nombre Affiches"
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & NombreAffiches
    DataLigne = DataLigne & "|" & Trim(NombreAffiches)
    Ligne = 97: TabDataFilm(Ligne) = DataLigne
    'lien page film
    DataLigne = "Lien Page Film"
    DataLigne = DataLigne & "|" & LienPageFilm
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 98: TabDataFilm(Ligne) = DataLigne
    'lien page affiches
    DataLigne = "Lien Page Affiches"
    DataLigne = DataLigne & "|" & LienPageAffiches
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 99: TabDataFilm(Ligne) = DataLigne
    'lien affiche
    DataLigne = "Lien Affiche"
    DataLigne = DataLigne & "|" & LienAffiche
    DataLigne = DataLigne & "|" & ""
    DataLigne = DataLigne & "|" & ""
    Ligne = 100: TabDataFilm(Ligne) = DataLigne
    '-----
    Ligne = 199
    For n = 1 To LigneFin
        'detecte ligne de data
        If InStr(LCase(TabDataHTML(n)), "réalisation") > 0 Then
            If InStr(LCase(TabDataHTML(n)), "#distribution-complete") > 0 Then
            'distribution complete
                'réalisation
                'interprétation
                'ecriture
                'production
                'montage
                'photographie
                'musique
                'costumes
                'décors
                'casting
                'maquillage
                'direction artistique
                'chef décoration
                'assistant réalisation
                'son
                'effets spéciaux
                'direction de production
                Data = Split(LCase(TabDataHTML(n)), "id=distribution-complete")(1)
                DataMETIER = Split(LCase(Split(LCase(Data), "<b>")(1)), "</b>")(0)
                DataTab = Split(LCase(Data), "com/")
                '-----
                For n2 = 1 To UBound(DataTab)
                    If InStr(DataTab(n2), "-nm") > 0 Then
                        Data = Split(DataTab(n2), Chr(34))(0)
                        DataURL = "www.cinemotions.com/" & Data
                        DataNAME = Split(LCase(Data), "-nm")(0)
                        '-----
                        DataLigne = DataMETIER
                        DataLigne = DataLigne & "|" & DataURL
                        DataLigne = DataLigne & "|" & DataNAME
                        DataLigne = DataLigne & "|" & Trim(FormatActeur(DataNAME))
                        Ligne = Ligne + 1: TabDataFilm(Ligne) = DataLigne
                        '-----
                        'test catégorie métier
                        If InStr(LCase(DataTab(n2)), "<b>") > 0 Then
                            DataMETIER = Split(LCase(Split(LCase(DataTab(n2)), "<b>")(1)), "</b>")(0)
                        End If
                    End If
                Next n2
                Exit For
            Else
            'distribution simple
                '----- réalisation , realisateur
                If InStr(LCase(Range("d" & n).Value), "director") > 0 Then
                    Data = Split(LCase(Split(LCase(TabDataHTML(n)), "com/")(1)), Chr(34))(0)
                    DataURL = "www.cinemotions.com/" & Data
                    DataNAME = Split(LCase(Data), "-nm")(0)
                    '-----
                    DataLigne = "réalisation"
                    DataLigne = DataLigne & "|" & DataURL
                    DataLigne = DataLigne & "|" & DataNAME
                    DataLigne = DataLigne & "|" & Trim(FormatActeur(DataNAME))
                    Ligne = Ligne + 1: TabDataFilm(Ligne) = DataLigne
                End If
                '----- comédiens , acteur
                If InStr(LCase(Range("d" & n).Value), "comédiens") > 0 Then
                    If InStr(LCase(TabDataHTML(n)), "actor") > 0 Then
                        Data = Split(LCase(TabDataHTML(n)), "comédiens")(1)
                        DataTab = Split(LCase(Data), "com/")
                        '-----
                        For n2 = 1 To UBound(DataTab)
                            Data = Split(DataTab(n2), Chr(34))(0)
                            DataURL = "www.cinemotions.com/" & Data
                            DataNAME = Split(LCase(Data), "-nm")(0)
                            '-----
                            DataLigne = "interprétation"
                            DataLigne = DataLigne & "|" & DataURL
                            DataLigne = DataLigne & "|" & DataNAME
                            DataLigne = DataLigne & "|" & Trim(FormatActeur(DataNAME))
                            Ligne = Ligne + 1: TabDataFilm(Ligne) = DataLigne
                        Next n2
                        Exit For
                    End If
                End If 'fin de distribution simple
            End If
        End If
    Next n
End Sub

Waouh...
grosse explication en perspective

pour comprendre , il faut voir en parallèle les 3 captures en dessous,
c'est le fichier.txt qui va être créé , et qui contient :
les données standards pour alimenter la ligne de la DataBase
les adresses (URL) des affiches
les adresses (URL) des pages/fiches des personnes

ces URL sont prévues pour extraire (avec un autre form) les data des personnes

les données standards



les adresses (URL) des affiches



les adresses (URL) des pages/fiches des personnes



le fait de reprendre le programme , je m'aperçois de pas mal de bug , rien est parfait...
voila donc ce que j'ai vu dans la capture 1 du fichier.txt



Genre devrait être :
Genre||Science Fiction|Science_Fiction ... ou
Genre||Science-Fiction|Science_Fiction ... ou
Genre|||Science_Fiction ... ou

idem pour Année :
Année||2017|2017 ..ou
Année||2016|2017 ..ou
Année|||2017 ..ou

une explication vite fait sur se fichier.txt
sa fonction première est de garder les adresses (URL) des pages/fiches des personnes ,
pour pouvoir les reprendre une à une et en extraire les Data avec le form dédié au Acteurs (par exemple)

les lignes du fichier sont "hachées" avec le caractère "|" ,
pour extraire le 4° élément d'une ligne , on peut utiliser : Element4=Split(DataLigne,"|")(NumElement-1)

du coup , pourquoi ne pas écrire le plus de renseignement possible ???
voila donc le pourquoi du comment...

encore une fois je précise que tout cela doit être pris comme un exemple d'utilisation...pour déclencher une idée...

[mjpmjp]

Bonjour,

dans le navigateur , on a sélectionné la fiche du film et la page se charge , on le sait parce que on la voit
mais est elle totalement chargée ? si ce n'est pas le cas , analyser une page incomplète serait une perte de temps et d'info !!!

contrôler si la page est chargée complétement

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
 
'-----
    'READYSTATE_UNINITIALIZED = 0
    'READYSTATE_LOADING = 1
    'READYSTATE_LOADED = 2
    'READYSTATE_INTERACTIVE = 3
    'READYSTATE_COMPLETE = 4
    'On boucle tant que la page n'est pas totalement chargée
    'pTimeOut est un time out en secondes (WaitIE vaut True si Timeout)
    Dim lTimer As Double
    lTimer = Timer
    pTimeOut = 2
    Do
        DoEvents
        If objWB.readyState = READYSTATE_COMPLETE And Not objWB.Busy Then Exit Do
        If pTimeOut > 0 And Timer - lTimer > pTimeOut Then Exit Do
    Loop
    '-----

la boucle Do..Loop n'a pas de fin , pour en sortir il faut soit :
le chargement de la page : If objWB.readyState = READYSTATE_COMPLETE And Not objWB.Busy Then Exit Do
l'expiration du délais fixé à 2 secondes : If pTimeOut > 0 And Timer - lTimer > pTimeOut Then Exit Do

maintenant que la page est chargée , on désigne un object comme étant "l’intérieur" de cette page

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
    '-----
    ' Page chargée, on continue
    Set objDoc = objWB.document
    '-----

objDoc est notre nouveau terrain de jeu
tout dépend maintenant de la façon dont le code à été écrit ,
dans les règles ? , quelles règles ? , quelle version ?,...

ICI , l’approche / stratégie est de
mettre toutes les "table" du document objDoc dans l'object "DataTab"
parcourir l'object DataTab à la recherche des "td"

mettre tous les "td" du document objDoc dans l'object "DataTD"
parcourir l'object DataTD à la recherche des "innerHTML" , c'est à dire du code HTML contenu entre "<td>" et "</td>"

tout cela pour mettre les lignes de code HTML dans le tableau TabDataHTML()
qui a été redimensionné pour 2000 lignes : ReDim TabDataHTML(2000) ce qui a tout effacé dans le tableau

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
 
'-----
    Ligne = 1
    Set DataH = objDoc.getElementsByTagName("head")
    For n = 1 To DataH(0).all.Length - 1
        TabDataHTML(Ligne) = DataH(0).all(n).outerHTML
        Ligne = Ligne + 1
    Next n
    Set DataTab = objDoc.getElementsByTagName("table")
    For n = 1 To DataTab.Length - 1
        Set DataTD = DataTab(n).getElementsByTagName("td")
        For n2 = 1 To DataTD.Length - 1
            TabDataHTML(Ligne) = DataTD(n2).innerHTML
            Ligne = Ligne + 1
        Next n2
    Next n
    '-----

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
LigneFin = UBound(TabDataHTML)

non ce n'est pas un bug : LigneFin = UBound(TabDataHTML) c'est juste une ligne maladroite
(j'ai vérifié) LigneFin = 2000 , on aurait pu croire que c'était les lignes "pleines" du tableau ... et non

c'est pas grave , on a quand même notre tableau avec les lignes de code HTML !!!

on la vu , " tout dépend maintenant de la façon dont le code à été écrit , " ...
alors voyons le code !!!
dans "Firefox" (par exemple) , quand vous êtes sur la page du film , faites F12...



et voila le code !!! ne pas perdre de vue , la propriété intellectuelle , les droits , et les machins , et les choses...!!!

[mjpmjp]

Bonjour,

notre cible



comme je le disais , on est dans un code qui peut changer d'une page à l'autre ,
et justement la recherche dans cette page ne fonctionne pas correctement ,
ce qui va nous permettre de pénétrer plus profondément dans l'explication

voila donc le résultat , qui n'est pas correct



souvenez vous le bug trouvé un peut plus haut et qu'il semble être lié au même problème



notre nouvelle cible (qui fonctionne)



et le résultat correct



comme vous pouvez le constater , la structure / apparence des deux cibles est indentiques !!!

voyons le code de cette page



la ligne utilisée pour l'extraction (qui fonctionne)



et celle de la page de notre étude (qui ne fonctionne pas)

[mjpmjp]

Bonjour,

le problème , c'est le choix (stratégie) de la ligne pour extraire les info

cette ligne n'est pas lié à l'apparence de la cible ce qui nous le voyons bien est très important !!!

je vais quand même vous expliquez comment fonctionnait ce code , et ensuite , je le modifierais...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
    '----- description
    DataElement = objDoc.getElementsByName("description")
    TabElement = Split(DataElement.Content, "-")
    '-----

la base du code , était de chercher dans objDoc
un élément ayant pour nom "description" : DataElement = objDoc.getElementsByName("description")

cet élément c'est notre ligne qui commence par : <meta name="description"

quand cette ligne est trouvée , on la stocke dans la variable DataElement ,
on découpe son contenu (DataElement.Content) en "morceau" entre chaque "-" : TabElement = Split(DataElement.Content, "-")
le reste consiste à traiter les éléments stocké dans le tableau TabElement par la fonction Split
TabElement(0)="La Planète des singes (Planet of the Apes)
TabElement(1)=" 2001 "
TabElement(2)=" Aventure... ..."

A la recherche de la ligne perdue...
je retourne (dans le navigateur) sur la page (qui ne fonctionne pas) , je fais "F12" , le code apparait , je clique sur les triangles de <head> et <body pour les fermer



puisque on a un outil , utilisons le !! ... , dans sa barre menu , je clique à gauche sur le carré avec une fleche...



maintenant avec la souris , je me positionne sur le titre



e "Titre" et "Alias" Sont géolocalisés dans le code !!!...je vois que
le "Titre" est entre "<h1>" et "</h1>"
le "Alias" est entre "<h2>" et "</h2>"
c'est peut être une piste ?

je décide de garder l'ancien code , qui fonctionne bien avec de nombreuses pages ,
et j'ajoute un test (qui doit être solide) sur l'année

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
 
'----- description
    DataElement = objDoc.getElementsByName("description")
    TabElement = Split(DataElement.Content, "-")
    '----- test de version
    If Len(Trim(TabElement(1))) = 4 And Val(Trim(TabElement(1))) > 1800 Then
        If InStr(TabElement(0), "(") > 0 Then
            Titre = Trim(FormatTitre(Split(TabElement(0), "(")(0)))
            Alias = Trim(FormatTitre(Replace(Split(TabElement(0), "(")(1), ")", "")))
        Else
            Titre = Trim(FormatTitre(TabElement(0)))
            Alias = ""
        End If
        'titre
        DataLigne = "Titre"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Trim(TabElement(0))
        DataLigne = DataLigne & "|" & Titre
        Ligne = 1: TabDataFilm(Ligne) = DataLigne
        'alias
        DataLigne = "Alias"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Trim(TabElement(0))
        DataLigne = DataLigne & "|" & Alias
        Ligne = 2: TabDataFilm(Ligne) = DataLigne
        'année
        DataLigne = "Année"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Trim(TabElement(1))
        DataLigne = DataLigne & "|" & Trim(TabElement(1))
        Ligne = 3: TabDataFilm(Ligne) = DataLigne
        'genre
        If InStr(LCase(TabElement(2)), "science") > 0 Then
            DataGenre = "Science-Fiction"
        Else
            DataGenre = Trim(TabElement(2))
        End If
        DataLigne = "Genre"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Trim(TabElement(2))
        DataLigne = DataLigne & "|" & DataGenre
        Ligne = 4: TabDataFilm(Ligne) = DataLigne
    Else
        MsgBox "une nouvelle version d'extraction est requise"
        'ICI...le code de la nouvelle version...2018-03-12
    End If
    '-----

je teste avec la page du film (2001) qui fonctionne , l'extraction se fait correctement ,
je teste avec la page du film (2017) , le test fonctionne et aiguille le code vers la prochaine version



bon , on y va , je vous préviens , c'est du code "à l’arrache" pour dépanner (à remplacer plus tard...oui , plus tard )
on l'a vu , j'ai situé le code HTML...qui est dans cette zone



comment arriver dans cette zone ?
il y a ce lien : href="/La-Planete-des-Singes-Suprematie-tt122607"
j'ai mon Titre : La Planete Des Singes - C3 - Suprematie (2017)...
je ne peut pas utiliser "La Planete Des Singes" , parce que si dans la page , on parle d'une suite ou d'un épisode précédent il est possible de voir à nouveau "La Planete Des Singes"

alors j'ai testé ce code dans la partie de la nouvelle version

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
    Else
        'MsgBox "une nouvelle version d'extraction est requise"
        'ICI...le code de la nouvelle version...2018-03-12
        MsgBox objWB.document.URL
    End If

Résultat



une petite modif

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
    Else
        'MsgBox "une nouvelle version d'extraction est requise"
        'ICI...le code de la nouvelle version...2018-03-12
        DataLien = "href=" & Chr(34) & "/" & Split(objWB.document.URL, "com/")(1) & Chr(34)
        MsgBox objWB.document.URL & vbCrLf & DataLien
    End If

Résultat



voila notre "laissez passer" pour la zone !!!

pour savoir si mon idée fonctionne ,
je clique droit sur la page du film et "code source de la page"
dans le code source je clique droit et "tout sélectionner"
je copie et colle dans un simple fichier texte.txt , que j'ouvre avec bloc note...

je me positionne au début ,
dans le menu je clique "édition" et "rechercher"
rechercher : href="/La-Planete-des-Singes-Suprematie-tt122607" et suivant
BINGO !!! pile dans la Zone !!!

pour contrôler , je modifie le code

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
 
    Else
        'MsgBox "une nouvelle version d'extraction est requise"
        'ICI...le code de la nouvelle version...2018-03-12
        DataLien = "href=" & Chr(34) & "/" & Split(objWB.document.URL, "com/")(1) & Chr(34)
        'MsgBox objWB.document.URL & vbCrLf & DataLien
        Msg = objWB.document.URL & vbCrLf & DataLien
        For n = 1 To LigneFin
            'detecte ligne de data
            If InStr(TabDataHTML(n), DataLien) > 0 Then
                Msg = Msg & vbCrLf & vbCrLf & "Correspondance trouvée ligne..." & n
                Msg = Msg & vbCrLf & vbCrLf & TabDataHTML(n)
                Exit For
            End If
        Next n
        MsgBox Msg
    End If

dans la Zone , il faut atteindre ce bout de code HTML : <span itemprop="name">La Planète des Singes - Suprématie</span>
qui peut être noyé dans une ligne super longue !!
quand le ligne est trouvée , on va la couper en 2 morceaux à partir de ... itemprop="name"> ...
le morceau avant la coupure..(0) : "<span "
le morceau après la coupure..(1) : "La Planète des ..."

nous , on veux le morceau d’après ... (1)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Data1 = Split(LCase(TabDataHTML(n)), "itemprop=" & Chr(34) & "name" & Chr(34) & ">")(1)

notez : l'usage de LCase() qui met tout en minuscule
donc , avec LCase(TabDataHTML(n)) , la ligne "n" du tableau TabDataHTML() qui contient le code HTML du document objDoc est mise en minuscule

pourquoi ? , tout simplement parce que on peut trouvé "<span" ou "<SPAN" et la fonction Split() fait la différence !!

notre morceau Data1 ressemble à çà : La Planète des Singes - Suprématie</span></a></h1> ...

on va le couper en morceaux à l’endroit où se trouve "<" ... il y aura au moins 4 morceaux de 0 à 3
(0) La Planète des Singes - Suprématie --> c'est celui qui nous intéresse
(1) /span
(2) /a
(3) /h1> ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Data2 = Split(Data1, "<")(0)

Data2 contient le morceau (0) du morceau Data1 : "La Planète des Singes - Suprématie"

le code modifié

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
 
    Else
        'MsgBox "une nouvelle version d'extraction est requise"
        'ICI...le code de la nouvelle version...2018-03-12
        '-----
        Msg = objWB.document.URL
 
        DataLien = "href=" & Chr(34) & "/" & Split(objWB.document.URL, "com/")(1) & Chr(34)
 
        Msg = Msg & vbCrLf & DataLien
 
        For n = 1 To LigneFin
            'detecte ligne de data
            If InStr(LCase(TabDataHTML(n)), LCase(DataLien)) > 0 Then
                'Correspondance trouvée ligne... n
                Msg = Msg & vbCrLf & vbCrLf & "Correspondance trouvée ligne..." & n
                Ligne = n
                Exit For
            End If
        Next n 
 
        For n = Ligne To LigneFin
            'detecte "itemprop"
            If InStr(LCase(TabDataHTML(n)), "itemprop=" & Chr(34) & "name" & Chr(34) & ">") > 0 Then
                'Correspondance trouvée ligne... n
                Msg = Msg & vbCrLf & vbCrLf & "Titre trouvé ligne..." & n
                Data = Split(Split(LCase(TabDataHTML(n)), "itemprop=" & Chr(34) & "name" & Chr(34) & ">")(1), "<")(0)
                Exit For
            End If
        Next n
 
        Msg = Msg & vbCrLf & vbCrLf & "Titre du Film ... " & Data
        MsgBox Msg
    End If

Résultat



passons maintenant à "Alias" ,
j'appelle "Alias" l'autre Titre de ce film qui est souvent dans une autre langue ,

voila la portion qui nous intéresse : text-decoration:none">War for the Planet of the Apes</h2>

on la vu , beaucoup plus haut :
le "Titre" et "Alias" Sont géolocalisés dans le code !!!...je vois que
le "Titre" est entre "<h1>" et "</h1>"
le "Alias" est entre "<h2>" et "</h2>"
c'est peut être une piste ?

effectivement je vais faire un essais avec "</h2>"
ce qui va nous donner : "... text-decoration:none">War for the Planet of the Apes"
quelle différence ? ... et bien ... une grosse !!
le "Alias" est au bout de ce morceau qui peut être très long (voir les ... du début)
quand on va découper à chaque ">" , on prendra le dernier morceaux

le code "Alias" qui vient à la suite...

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
 
        '----- Alias
        For n = Ligne To Ligne + 10
            'detecte ligne de data
            If InStr(LCase(TabDataHTML(n)), "</h2>") > 0 Then
                'Correspondance trouvée ligne... n
                Ligne = n
 
                TabElement = Split(Split(LCase(TabDataHTML(n)), "</h2")(0), ">")
                Data = TabElement(UBound(TabElement))
                MsgBox Data
 
                Exit For
            End If
        Next n
Résultat

Résultat



la démarche est la même que pour le "Titre" , sauf que pour le morceau 2 , je n'ai pas utilisé (0) ou (n)
pour le dernier élément : Ubound(Split(Split(LCase(TabDataHTML(n)), "</h2")(0), ">"))
on peut écrire : Split(Split(LCase(TabDataHTML(n)), "</h2")(0), ">")(Ubound(Split(Split(LCase(TabDataHTML(n)), "</h2")(0), ">")))
mais du coup on recalcule (les Split) en double

avec TabElement = Split(Split(LCase(TabDataHTML(n)), "</h2")(0), ">")
le tableau TabElement() reçoit le résultat des Split()
et il suffit de chercher le dernier élément du tableau : UBound(TabElement)

notre "Alias" est le dernier élément du tableau : Alias = TabElement(UBound(TabElement))

et la Date ?

pour la date , plus exactement l' "Année" du Film ,
<div style="height:17px; margin-left:9px;"> 2017 - Etats-Unis - 2h20 </div>

qu'est ce qui pourrait nous être utile ?
on sait que cette ligne est en dessous , pas très loin
on pourrait utiliser le même système que le test de tout à l'heure sur l' Année ?

après réflexion , c'est pas mal ,
on va donc limiter la recherche à une dizaine de lignes (en dessous) : For n = Ligne To Ligne + 10
on va découper chaque ligne avec ">" comme délimiteur... ce qui va nous donner : " 2017 - Etats-Unis ..."
on va utiliser la fonction Trim() pour supprimer les espaces au début et à la fin : "2017 - Etats-Unis ..."
on va utiliser la fonction Left() pour garder les 4 caractères de gauche : "2017"
on va utiliser la fonction Val() pour vérifier si la valeur des 4 caractères est supérieure à 1800
si on a "</h2" ... donc 4 caractères , la valeur est 2 ... donc pas une Année !!

voyons le code

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
 
        '----- Année
        Data = ""
        For n = Ligne To Ligne + 10
            TabElement = Split(TabDataHTML(n), ">")
            'detecte ligne de data
            For n2 = 0 To UBound(TabElement)
                Data = Left(Trim(TabElement(n2)), 4)
                If Val(Data) > 1800 Then
                    'Correspondance trouvée ligne... n
                    Ligne = n
                    Exit For
                End If
            Next n2
            If Data <> "" Then Exit For
        Next n
        MsgBox Data

Résultat



pour le "Genre" du Film ,

<div style="height:3px;"></div>
<a href="http://www.cinemotions.com/genre/fantastique" class="link_menu_film"><b><span itemprop="genre">Fantastique</span></b></a>
/<a href="http://www.cinemotions.com/genre/action" class="link_menu_film"><b><span itemprop="genre">Action</span></b></a>
/<a href="http://www.cinemotions.com/genre/aventures" class="link_menu_film"><b><span itemprop="genre">Aventures</span></b></a>
</div>

je vais m’orienter vers les "Lien" ,
il est possible de récupérer l'ensemble des liens du code HTML de l'object Document objDoc avec : objDoc.Links
pour connaitre le nombre de liens : LinkNum = objDoc.Links.Length - 1

je vais étudier tous les liens : For n = 0 To LinkNum
si dans un Lien je trouve "/genre/" , je le coupe en morceaux et je garde le morceau entre "/genre/" et chr(34) chr(34) = "
dans Data , je colle mes morceaux avec ";" à la fin , le dernier morceau aura lui aussi un ";" à la fin ... je le supprime avec : Data = Left(Data, Len(Data) - 1)

voyons le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
        '----- Genre
        Data = ""
        LinkNum = objDoc.Links.Length - 1
        If LinkNum > 0 Then
            For n = 0 To LinkNum
                If InStr(LCase(objDoc.Links(n)), "/genre/") > 0 Then
                    Data = Data & Split(Split(LCase(objDoc.Links(n)), "/genre/")(1), Chr(34))(0) & ";"
                End If
            Next n
            Data = Left(Data, Len(Data) - 1)
            MsgBox Data
        End If

Résultat

[mjpmjp]

Bonjour,

nous voila de retour , après cette modification en direct



comme on peut le voir , la modif fonctionne correctement

[mjpmjp]

Bonjour,

cette modif , nous a permis de voir la touche "F12" du clavier et l'Outil du Navigateur Web (ICI Firefox)

pour l'extraction du Synopsis / Résumé du Film , on va utiliser un code plus "Professionnel" (qui n'est pas forcément plus rapide ou efficace )

étudions le terrain avec F12



dans ce cas , j'ai ciblé le "Tag" HTML "span" et le but est de récupérer tout le texte entre le Tag de début et celui de fin (qui a un "/")
donc le Texte entre "<span>" et "</span>"

on a vu qu'on pouvait avoir une liste entière de "Lien" avec objDoc.Links

on peut également avoir une liste de "Tag" avec son Nom...le "TagName"
Set DataSpan = objDoc.getElementsByTagName("span")
la "Liste" est une "Collection"...c'est un Object Collection , et donc l'utilisation de "Set" pour dire que DataSpan est la Collection HTML des "Tag" ayants pour nom "span"

dans toute cette liste de "span" , comment trouver celui du résumé ?
on va le trouver par le mot "description" c'est un "outerHTML"
c'est le "outerHTML" du "span" de la ligne "n" dans la "Collection" DataSpan
ce qui s'écrit : DataSpan(n).outerHTML

vola le code (présenté plus haut)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
    'résumé / synopsis
    Set DataSpan = objDoc.getElementsByTagName("span")
    For n = 1 To 200
        If InStr(LCase(DataSpan(n).outerHTML), "description") > 0 Then
            DataResume = Trim(Replace(Replace(DataSpan(n).outerText, vbCrLf, ""), "|", ":"))
            Exit For
        End If
    Next n

et voila le nouveau code modifié (en Direct )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
    'résumé / synopsis
    NumSpan = objDoc.getElementsByTagName("span").Length
    Set DataSpan = objDoc.getElementsByTagName("span")
    For n = 1 To NumSpan
        If InStr(LCase(DataSpan(n).outerHTML), "description") > 0 Then
            DataResume = Trim(Replace(Replace(DataSpan(n).outerText, vbCrLf, ""), "|", ":"))
            Exit For
        End If
    Next n

la modif , c'est NumSpan qui est le nombre de ligne de la "Collection"

maintenant que j'ai trouvé la ligne qui correspond à l' "outerHTML" : "description" ,
je récupère le "Texte" qui est le "outerText" de la ligne "n" dans la "Collection" de "Tag" DataSpan

la ligne de code formate le code ,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
DataResume = Trim(Replace(Replace(DataSpan(n).outerText, vbCrLf, ""), "|", ":"))

elle supprime l'action de la "Balise" "</br>" qui est égale à "vbCrlf" (retour à la ligne) ,
le remplacement de "|" par ":" est pour certain cas...

on a vu l'essentiel de l'extraction , avec la partie AFFICHES DU FILM , je pense qu'on y reviendra encore un peut...

voila pour la partie EXTRACTION DATA WEB

@+JP

[mjpmjp]

Bonjour,

la "Liaison" (InterAction) a été activée et la cellule sélectionnée a ciblé une ligne de Film dans une liste / tableau / DataBase...
la "Tour de Contrôle" a contrôlé et aiguillé le code vers une des procédures spécialisé et spécifique : WorksheetAction_FormDataWebFilm()

cette procédure (sub) WorksheetAction_FormDataWebFilm() a ordonné de "préparer" le form pour un nouveau Film...

dans l'opération "Grand Ménage" ,
les "cases" jaunes et gris clair ont été effacées , les "OptionButton" ont été réglés ,
ET AUSSI , toute la partie "Affiche" a été nettoyée ...

dans l'opération "Chargement des Data du PC" ,
la ligne ciblée dans la DataBase a été retranscrite dans les "cases" jaunes
qui ont été dimensionnées en fonction de leur contenu
et l'ensemble des éléments de la frame FrmData a été repositionné
ET AUSSI , toute la partie "Affiche" a reçu son lot de Data ...

quand tout était propre , écrit , ordonné , le travail était terminé et donc : FormDataWebFilm_IsChangeInProgress = False

avant d'étudier le code , voyons la structure de la partie "Affiche"