Gestion de Film (Extraction Web, DataBase , Fiche Film , Recherche dans DB) v2

Version imprimable

Voir 40 message(s) de cette discussion en une page

13/09/2018, 16h17
mjpmjp

11 pièce(s) jointe(s)

Gestion de Film (Extraction Web, DataBase , Fiche Film , Recherche dans DB) v2

---------------------------------------------------
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 :ccool:
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

Pièce jointe 411346

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"

Pièce jointe 411355

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"

Pièce jointe 411358

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" :lol:

Pièce jointe 411366

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 Pièce jointe 412278 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"

Pièce jointe 411370

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 Pièce jointe 412279 et (pour les data web) dans les cases transparentes Pièce jointe 412281 à demandé pas mal de réflexions :fleur::fleur::fleur2::fleur2::rose:
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 :yaisse1:
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 !!! 8O

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

Pièce jointe 411371

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

Pièce jointe 411373

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 ,

Pièce jointe 411375

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 ) :D
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 ) :mouarf:
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 :zen:

Voila pour la Partie PRÉSENTATION :coucou:

@+JP
13/09/2018, 16h18
mjpmjp

9 pièce(s) jointe(s)

STRUCTURE DU FORM

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 ... :?

Pièce jointe 412302

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)

Pièce jointe 411387

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

Pièce jointe 411390

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

Pièce jointe 411391

la partie verte : le form --> FormDataWebFilm

Pièce jointe 411395

la partie bleue : la frame principale --> FrmPrincipal

Pièce jointe 411403

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

Pièce jointe 411406

la partie jaune : la frame menu --> FrmMenu

Pièce jointe 411409

la partie rose : la frame complement --> FrmComplement

Pièce jointe 411411

3 pièce(s) jointe(s)

Gestions des variables et appel du form

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

Pièce jointe 411414

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

Pièce jointe 411418

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

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

Pièce jointe 412253
Code:

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:

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:

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é !!!

La gestion des boutons et des frames

bonjour,

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

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 :P

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...

La frame du WebBrowser

bonjour,

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

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:

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" :weird:
est ce que "Set" suffit pour déclarer ???...tien voila du boulot pour notre amis Unparia ou un autre :ptdr:

La frame Extraire et Affiche

bonjour,

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

Code:

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:

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 :coucou:

@+JP

2 pièce(s) jointe(s)

WEBBROWSER

Bonjour,

le form est appelé par un bouton dans le ruban

Pièce jointe 411438
Code:

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:

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"

Pièce jointe 411443

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

1 pièce(s) jointe(s)

WEBBROWSER InterAction avec la Feuille

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:

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:

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 ...
Pièce jointe 411446

Code:

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:

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:

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:

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:

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

La Tour de Contrôle : WorksheetSelectionChange

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 :roll: )...

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

en premier , un autre double est fait (??? :weird: ) : 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 .... 8-)

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:

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 :mouarf:
Call WorksheetAction_FormDataWebFilm :bravo:

3 pièce(s) jointe(s)

Les Procédures (sub) Spécialisée : WorksheetAction_

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:

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:

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"

Pièce jointe 411459

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:

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

Pièce jointe 411462

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" :lol:

Résultat

Pièce jointe 411463

la Fiche du Film ...

voila pour la partie WEBBROWSER :coucou:

@+JP

13/09/2018, 16h24
mjpmjp

5 pièce(s) jointe(s)

EXTRACTION DATA WEB

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... :mouarf:

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

Pièce jointe 411466

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

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

Pièce jointe 412265

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 ... :nono: ...
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

Pièce jointe 411482

FrmExtraireData

Pièce jointe 411483

FrmData

Pièce jointe 411487

voila pour la structure , maintenant place au code

1 pièce(s) jointe(s)

Le Grand Ménage

Bonjour,

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

Code:

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

puis on chargeait les Data en provenance du PC

Code:

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

Pièce jointe 411490

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:

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 :aie:

Code:

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

2 pièce(s) jointe(s)

Charger les Data contenus dans le PC

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:

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:

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 ,

Pièce jointe 411493

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

Pièce jointe 411495

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

4 pièce(s) jointe(s)

Le bouton Extraire (Action)

Bonjour,

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

Code:

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:

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... :zen:
grosse explication en perspective :ptdr:

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

Pièce jointe 411498

les adresses (URL) des affiches

Pièce jointe 411502

les adresses (URL) des pages/fiches des personnes

Pièce jointe 411505

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

Pièce jointe 411507

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... :D

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

1 pièce(s) jointe(s)

Extraction , en avant toute

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 !!! :nono:

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

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:

1 2 3 4 5 '----- ' Page chargée, on continue Set objDoc = objWB.document '-----
objDoc est notre nouveau terrain de jeu :D
tout dépend maintenant de la façon dont le code à été écrit ,
dans les règles ? , quelles règles ? , quelle version ?,... :weird:

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:

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:

1 2 LigneFin = UBound(TabDataHTML)
:weird: non ce n'est pas un bug : LigneFin = UBound(TabDataHTML) c'est juste une ligne maladroite :aie:
(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 !!! :P

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...

Pièce jointe 411514

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

13/09/2018, 16h27
mjpmjp

8 pièce(s) jointe(s)

Le Titre , Alias , Année , le Genre

Bonjour,

notre cible

Pièce jointe 411518

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

Pièce jointe 411522

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

Pièce jointe 411525

notre nouvelle cible (qui fonctionne)

Pièce jointe 411529

et le résultat correct

Pièce jointe 411533

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

voyons le code de cette page

Pièce jointe 411535

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

Pièce jointe 411538

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

Pièce jointe 411541

12 pièce(s) jointe(s)

Problème , action , réaction , correction

Bonjour,

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

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:

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

Pièce jointe 411545

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

Pièce jointe 411546

maintenant avec la souris , je me positionne sur le titre

Pièce jointe 411550

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:

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 ;)

Pièce jointe 411551

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

Pièce jointe 411554

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:

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

Pièce jointe 411557

une petite modif
Code:

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

Pièce jointe 411559

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

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 !!! :mouarf: pile dans la Zone !!!

pour contrôler , je modifie le code
Code:

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
Pièce jointe 411567

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 !! 8O
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:

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:

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:

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

Pièce jointe 411563

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:

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

Pièce jointe 411571

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), ">"))) :nono:
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:

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

Pièce jointe 411574

pour le "Genre" du Film ,

Citation:

<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) :mouarf: 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:

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

Pièce jointe 411575

13/09/2018, 16h28
mjpmjp

1 pièce(s) jointe(s)

Extraction , le Retour

Bonjour,

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

Pièce jointe 411578

comme on peut le voir , la modif fonctionne correctement :D

1 pièce(s) jointe(s)

Le Résumé du Film / Synopsis

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 :aie: )

étudions le terrain avec F12

Pièce jointe 411585

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:

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 :ccool: )
Code:

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:

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 :coucou:

@+JP

13/09/2018, 16h30
mjpmjp

AFFICHES DU FILM

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"

Voir 40 message(s) de cette discussion en une page