Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut Gestion de Film (Extraction Web, DataBase , Fiche Film , Recherche dans DB)

    bonjour,
    je vais vous présenter un projet qui fonctionne
    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 359974

    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 359975

    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 359980

    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"

    Pièce jointe 359984

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

    le bouton "Extraire" et la frame "FrmExtraire"

    Pièce jointe 359985

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

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

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

    Pièce jointe 359989

    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 359994

    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 359997

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

    voila de quoi s'occuper

    Voila pour la Partie PRÉSENTATION

    @+JP
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  2. #2
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut STRUCTURE DU FORM

    bonjour,

    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 360017

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

    Pièce jointe 360019

    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 360024

    la partie verte : le form --> FormDataWebFilm

    Pièce jointe 360027

    la partie bleue : la frame principale --> FrmPrincipal

    Pièce jointe 360030

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

    Pièce jointe 360032

    la partie jaune : la frame menu --> FrmMenu

    Pièce jointe 360037

    la partie rose : la frame complement --> FrmComplement

    Pièce jointe 360040
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  3. #3
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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
    ici pour le form FormDataWebFilm

    Pièce jointe 360042

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

    Pièce jointe 360044

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

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

    nous y sommes !!!
    le form est appelé par un bouton dans le ruban
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
    'Callback for BtnWEB_DataFilm onAction
    Sub RECHERCHE_DATA_WEB_FILM(control As IRibbonControl)
        'form Data Web Film
        FormDataWebFilm.Show
    End Sub
    dans les propriétés du form , ShowModal = false , pour être "indépendant" de la feuille

    voyons le code qui ce lance AVANT de voir le form
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
     
    Private Sub UserForm_Initialize()
        '-----
        Call VariableInitialyse
        Set objFormDataWebFilm = Me
        FormDataWebFilm_IsLoad = True
        '-------------------------------
        Me.ScrollBars = fmScrollBarsNone
        '-------------------------------
        'ferme le volet complement
        Me.Height = 436
        Me.Width = 562
        '-------------------------------
        Me.FrmPrincipal.ScrollWidth = 0
        Me.FrmWebBrowser.Left = 0
        '-----
        Me.CbxGenre.RowSource = "TabxlGenre[Genre]"
        '-----
        Me.FrmAfficheZoom.Visible = False
        Me.FrmAfficheW.Width = 502
        Me.FrmAfficheD.Width = 502
        Me.ScrollBar1.Width = 502
        Me.CmdZoom.Caption = 1
        'couleur "normale"
        Me.CmdZoom.BackColor = &H8000000F
        Me.CmdZoom.ForeColor = &H80000002
        Me.ImageZoom.Picture = Nothing
        '-----
        'couleur "active"
        Me.CmdCouperColler.BackColor = &H80000002
        Me.CmdCouperColler.ForeColor = &H8000000F
        '-----
        Set objWB = FrmWebBrowser.Object("WebBrowser1")
        objWB.Silent = True
        objWB.Navigate "http://www.cinemotions.com"
        '-----
        'On boucle tant que la page n'est pas totalement chargée
        ' pTimeOut est un time out en secondes (WaitIE vaut True si Timeout)
        Dim lTimer As Double
        lTimer = Timer
        pTimeOut = 4
        Do
            DoEvents
            If objWB.readyState = READYSTATE_COMPLETE And Not objWB.Busy Then Exit Do
            If pTimeOut > 0 And Timer - lTimer > pTimeOut Then Exit Do
        Loop
     
        ' Page chargée, on continue
        Set objDoc = objWB.document
    End Sub
    les autres événements du form
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
     
    Private Sub UserForm_Activate()
    End Sub
     
    Private Sub UserForm_Terminate()
        FormDataWebFilm_IsLoad = False
    End Sub
    l' événement activate n'est pas utilisé !!!
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  4. #4
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut La gestion des boutons et des frames

    bonjour,

    voila la gestion des bouton et des frames "Options" et "Complement"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
     
    '===================================================================== Form
    '------------------------------------------------------- Btn Options Frm
    Private Sub LblOptionsFrm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblOptionsFrm.SpecialEffect = fmSpecialEffectSunken
    End Sub
    Private Sub LblOptionsFrm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblOptionsFrm.SpecialEffect = fmSpecialEffectRaised
    End Sub
    Private Sub LblOptionsFrm_Click()
        If Me.LblOptionsFrm.BackColor = &H80000002 Then
            'ferme
            Me.LblOptionsFrm.BackColor = &H8000000F 'normal
            'action
            '-----
            Me.FrmOptions.Left = 600
            '-----
        Else
            'ouvre
            Me.LblOptionsFrm.BackColor = &H80000002 'actif
            'action
            '-----
            Me.FrmOptions.Left = 0
            '-----
        End If
    End Sub
    '------------------------------------------------------- Btn Complément Frm
    Private Sub LblComplementFrm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblComplementFrm.SpecialEffect = fmSpecialEffectSunken
    End Sub
    Private Sub LblComplementFrm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblComplementFrm.SpecialEffect = fmSpecialEffectRaised
    End Sub
    Private Sub LblComplementFrm_Click()
        If Me.LblComplementFrm.BackColor = &H80000002 Then
            'ferme
            Me.LblComplementFrm.BackColor = &H8000000F 'normal
            'action
            '----- volet des Complement
            Me.Height = 436
            '-----
        Else
            'ouvre
            Me.LblComplementFrm.BackColor = &H80000002 'actif
            'action
            '----- volet des Complement
            Me.Height = 630
            '-----
        End If
    End Sub
    vous noterez non seulement l’indentation du code , mais aussi le classement des sub et fonction...
    ici on a une barre ===== Form
    puis dans ce form on a des -------- Btn Options Frm (pour les bouton)

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

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

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

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

    la frame principale n'est là que pour la construction du form dans le VBE afin d'utiliser un scroll pour pouvoir "étaler" horizontalement les objects...
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  5. #5
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut La frame du WebBrowser

    bonjour,

    on garde les bonnes habitudes , la gestion du code...
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
     
    '===================================================================== WebBrowser
    '------------------------------------------------------- Btn WebBrowser Frm
    Private Sub LblWebBrowserFrm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblWebBrowserFrm.SpecialEffect = fmSpecialEffectSunken
    End Sub
     
    Private Sub LblWebBrowserFrm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblWebBrowserFrm.SpecialEffect = fmSpecialEffectRaised
    End Sub
     
    Private Sub LblWebBrowserFrm_Click()
        If Me.LblWebBrowserFrm.BackColor = &H80000002 Then
            'ferme
            Me.LblWebBrowserFrm.BackColor = &H8000000F 'normal
            'action
            '-----
            Me.FrmWebBrowser.Left = 1200
            '-----
        Else
            'ouvre
            Me.LblWebBrowserFrm.BackColor = &H80000002 'actif
            Me.LblExtraireFrm.BackColor = &H8000000F 'normal
            Me.LblAfficheFrm.BackColor = &H8000000F 'normal
            'action
            '-----
            Me.FrmWebBrowser.Left = 0
            Me.FrmExtraire.Left = 1200
            Me.FrmAffiche.Left = 1200
            '-----
        End If
    End Sub
     
    '------------------------------------------------------- Btn Navigate
    Private Sub LblNavigate_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblNavigate.SpecialEffect = fmSpecialEffectSunken
    End Sub
     
    Private Sub LblNavigate_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblNavigate.SpecialEffect = fmSpecialEffectRaised
    End Sub
     
    Private Sub LblNavigate_Click()
        If Me.LblNavigate.BackColor = &H80000002 Then
            'ferme
            Me.LblNavigate.BackColor = &H8000000F 'normal
            'action
            '-----
            FormDataWebFilm_IsNavigate = False
            '-----
        Else
            'ouvre
            Me.LblNavigate.BackColor = &H80000002 'actif
            'action
            '-----
            FormDataWebFilm_IsNavigate = True
            '-----
            If objFormDataWebFilm.TxbTitreList.Value <> "" Then
                WBAdress = "http://www.cinemotions.com/recherche/" & LCase(Trim(Replace(objFormDataWebFilm.TxbTitreList.Value, " - ", "-")))
                objWB.Navigate (WBAdress)
            End If
            '-----
        End If
    End Sub
    ici , on pousse les frames un peut plus loin : 1200
    quand le bouton WebBrowser est actif , les autres (frame) sont déactivés
    idem pour les frames , quand celle du WebBrowser vient à left=0 , les autres sont repoussées à left = 1200

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

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

    je vous rappelle ce bout de code dans UserForm_Initialize
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
        '-----
        Set objWB = FrmWebBrowser.Object("WebBrowser1")
        objWB.Silent = True
        objWB.Navigate "http://www.cinemotions.com"
        '-----
    c'est là que l'object objWB à été déterminé comme étant l'object "WebBrowser1" contenu dans la frame FrmWebBrowser

    je dois avouer que je n'est pas trouvé (dans ma liste de variables et autres) la déclaration de l'object "objWB"
    est ce que "Set" suffit pour déclarer ???...tien voila du boulot pour notre amis Unparia ou un autre
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  6. #6
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut La frame Extraire et Affiche

    bonjour,

    toujours le même schémas , on active , on pousse ,...
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
     
    '===================================================================== Extraire
    '------------------------------------------------------- Btn Extraire Frm
    Private Sub LblExtraireFrm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblExtraireFrm.SpecialEffect = fmSpecialEffectSunken
    End Sub
     
    Private Sub LblExtraireFrm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblExtraireFrm.SpecialEffect = fmSpecialEffectRaised
    End Sub
     
    Private Sub LblExtraireFrm_Click()
        If Me.LblExtraireFrm.BackColor = &H80000002 Then
            'ferme
            Me.LblExtraireFrm.BackColor = &H8000000F 'normal
            'action
            '-----
            Me.FrmExtraire.Left = 1200
            '-----
        Else
            'ouvre
            Me.LblWebBrowserFrm.BackColor = &H8000000F 'normal
            Me.LblExtraireFrm.BackColor = &H80000002 'actif
            Me.LblAfficheFrm.BackColor = &H8000000F 'normal
            'action
            '-----
            Me.FrmWebBrowser.Left = 1200
            Me.FrmExtraire.Left = 0
            Me.FrmAffiche.Left = 1200
            '-----
        End If
    End Sub
     
    '------------------------------------------------------- Btn Extraire
    Private Sub LblExtraire_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblExtraire.SpecialEffect = fmSpecialEffectSunken
    End Sub
     
    Private Sub LblExtraire_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblExtraire.SpecialEffect = fmSpecialEffectRaised
    End Sub
     
    Private Sub LblExtraire_Click()
        If Me.LblExtraire.BackColor = &H80000002 Then
            'ferme
            Me.LblExtraire.BackColor = &H8000000F 'normal
        Else
            'ouvre
            Me.LblExtraire.BackColor = &H80000002 'actif
            'action
            FormDataWebFilm_IsChangeInProgress = True
            '-----
            Call DataFilmWebExtraire(objFormDataWebFilm)
            Call DataFilmWebOrganiser
            Call DataFilmWebEfface(objFormDataWebFilm)
            Call DataFilmWebLire(objFormDataWebFilm)
            Call DataFilmWebOption(objFormDataWebFilm)
            '----- efface affiche
            Call AfficheFormEffaceWeb(objFormDataWebFilm)
            Call DataFilmAfficheWeb(objFormDataWebFilm)
            Call AffichesPageWeb(objFormDataWebFilm)
            '-----
            FormDataWebFilm_IsChangeInProgress = False
            'bouton
            Me.LblExtraire.BackColor = &H8000000F 'normal
        End If
    End Sub
     
    '------------------------------------------------------- Btn Transfer 2 (FrmExtraire)
    Private Sub LblTransfer2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblTransfer2.SpecialEffect = fmSpecialEffectSunken
    End Sub
     
    Private Sub LblTransfer2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblTransfer2.SpecialEffect = fmSpecialEffectRaised
    End Sub
     
    Private Sub LblTransfer2_Click()
        If Me.LblTransfer2.BackColor = &H80000002 Then
            'ferme
            Me.LblTransfer2.BackColor = &H8000000F 'normal
        Else
            'ouvre
            Me.LblTransfer2.BackColor = &H80000002 'actif
            'action
            FormDataWebFilm_IsChangeInProgress = True
            '-----
            Call DataFilmTransfer(objFormDataWebFilm)
            Call DataFilmAfficheTransfer(objFormDataWebFilm)
            Call DataFilmFichierCreer(objFormDataWebFilm)
            '-----
            FormDataWebFilm_IsChangeInProgress = False
            'bouton
            Me.LblTransfer2.BackColor = &H8000000F 'normal
        End If
    End Sub
    attention...çà ne rigole plus , une nouvelle variable , "FormDataWebFilm_IsChangeInProgress" , là çà veut dire...je suis en train de travailler !!!
    vous avez vu la masse de travail ...houla...bon ben on verra çà dans la partie EXTRACTION DATA WEB
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
     
            FormDataWebFilm_IsChangeInProgress = True
            '-----
            Call DataFilmWebExtraire(objFormDataWebFilm)
            Call DataFilmWebOrganiser
            Call DataFilmWebEfface(objFormDataWebFilm)
            Call DataFilmWebLire(objFormDataWebFilm)
            Call DataFilmWebOption(objFormDataWebFilm)
            '----- efface affiche
            Call AfficheFormEffaceWeb(objFormDataWebFilm)
            Call DataFilmAfficheWeb(objFormDataWebFilm)
            Call AffichesPageWeb(objFormDataWebFilm)
            '-----
            FormDataWebFilm_IsChangeInProgress = False
    pour la frame Affiche , vous avez compris le mécanisme , c'est pas utile d'en rajouter

    voila pour la partie STRUCTURE DU FORM

    @+JP
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  7. #7
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut WEBBROWSER

    Bonjour,

    le form est appelé par un bouton dans le ruban

    Pièce jointe 360074

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
     
    '==================================================================================================== WEB Data
    'Callback for BtnWEB_DataFilm onAction
    Sub RECHERCHE_DATA_WEB_FILM(control As IRibbonControl)
        'form Data Web Film
        FormDataWebFilm.Show
    End Sub
    nous y reviendrons plus tard , mais il faut savoir comment sont déclaré objWB et objDoc
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
    Public objWB As SHDocVw.WebBrowser 
    Public objDoc As MSHTML.HTMLDocument
    dans l’événement UserForm_Initialize
    l'object objFormDataWebFilm est initialisé : Set objFormDataWebFilm = Me

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

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

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

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

    Pièce jointe 360085

    ici , le bouton "Navigate" n'est pas activé ,
    on a vu , plus haut , ce qui se passe quand on active le bouton...
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  8. #8
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
     
    '------------------------------------------------------- Btn Navigate
    Private Sub LblNavigate_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblNavigate.SpecialEffect = fmSpecialEffectSunken
    End Sub
     
    Private Sub LblNavigate_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblNavigate.SpecialEffect = fmSpecialEffectRaised
    End Sub
     
    Private Sub LblNavigate_Click()
        If Me.LblNavigate.BackColor = &H80000002 Then
            'ferme
            Me.LblNavigate.BackColor = &H8000000F 'normal
            'action
            '-----
            FormDataWebFilm_IsNavigate = False
            '-----
        Else
            'ouvre
            Me.LblNavigate.BackColor = &H80000002 'actif
            'action
            '-----
            FormDataWebFilm_IsNavigate = True
            '-----
            If objFormDataWebFilm.TxbTitreList.Value <> "" Then
                WBAdress = "http://www.cinemotions.com/recherche/" & LCase(Trim(Replace(objFormDataWebFilm.TxbTitreList.Value, " - ", "-")))
                objWB.navigate (WBAdress)
            End If
            '-----
        End If
    End Sub
    on voit bien le mécanisme quand on active le bouton ,
    le code teste si la TextBox du Titre (qui est dans la frame FrmData) contient le Titre d'un Film :
    If objFormDataWebFilm.TxbTitreList.Value <> "" Then
    si c'est le cas , il construit l'adresse WBAdress qui va être utilisée pour la navigation : objWB.navigate (WBAdress)

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

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

    Activate() : quand l'onglet est ouvert / sélectionné
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
    Private Sub Worksheet_Activate()
        Call VariableInitialyse
        Call FILMS_NewLabel(Application.WorksheetFunction.Sum(Range(ListColonInd & ListLigneDebut & ":" & ListColonInd & ListLigneFinMax)), False)
        Call WorksheetActivate
    End Sub
    les variables sont initialisées avec Call VariableInitialyse (on la vu , dans la gestion des variables et autres) ,
    ensuite , le Ruban "Ribbon" (le Menu d'Excel) est modifié avec FILMS_NewLabel(Data As String, Redessine As Boolean)

    Pièce jointe 360144

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
     
    Public Function FILMS_NewLabel(Data As String, Redessine As Boolean)
        Dim n As Integer
        On Error GoTo ErrRuban
        NewLabel_List = "Liste "
        For n = 1 To 4 - Len(Data)
            NewLabel_List = NewLabel_List & "0"
        Next n
        NewLabel_List = NewLabel_List & Data & " FILM"
        'redessine le cotrole Label "TabList" du ruban
        If Redessine Then objRuban.InvalidateControl ("TabList")
        Exit Function
    ErrRuban:
        Set objRuban = Ribbon
        Resume Next
    End Function
    Deactivate() : quand on quitte l'onglet , le compteur est mis à Zéro
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
    Private Sub Worksheet_Deactivate()
        If Test_OperationEnCours Then Exit Sub
        Call WorksheetDeactivate
    End Sub
    SelectionChange(ByVal Target As Range) : quand on clique dans la feuille , on sélectionne une cellule
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Test_OperationEnCours Then Exit Sub
        Set ListCelluleSelected = Target
        Call WorksheetSelectionChange(Target)
    End Sub
    c'est ICI que débute l' InterAction entre la Feuille et le Form
    ces 3 évènements appellent des codes communs à plusieurs Feuilles qui sont dans le Module : JP_System_WorkSheet
    pour Activate() et Deactivate() qui gèrent la modif du "Ribbon"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
     
    Public Sub WorksheetActivate()
    On Error GoTo ErrVariables
        'mémorise ListTotalFilmNumber
        Cell_ListTotalFilmNumber.Value = Application.WorksheetFunction.Sum(Worksheets(ActiveSheet.Name).Range(ListColonInd & ListLigneDebut & ":" & ListColonInd & ListLigneFinMax))
        Call FILMS_NewLabel(Cell_ListTotalFilmNumber.Value, True)
        'mémorise ListTotalFilmOctet
        Cell_ListTotalFilmOctet.Value = Application.WorksheetFunction.Sum(Worksheets(ActiveSheet.Name).Range(ListColonCdTotal & ListLigneDebut & ":" & ListColonCdTotal & ListLigneFinMax))
        Exit Sub
    ErrVariables:
        Call VariableInitialyse
        Resume Next
    End Sub
     
    Public Sub WorksheetDeactivate()
    On Error GoTo ErrRuban
        NewLabel_List = "Liste " & "0000 FILM"
        'redessine le cotrole Label "TabList" du ruban
        objRuban.InvalidateControl ("TabList")
        Exit Sub
    ErrRuban:
        Set objRuban = Ribbon
        Resume Next
    End Sub
    pour SelectionChange(ByVal Target As Range)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
     
    Public Sub WorksheetSelectionChange(Target As Range)
        'cellule sélectionnée
        Set ListCelluleSelected = Target
        'Ligne de la cellule sélectionnée
        ListLigneSelected = Target.Row
        'Colonne de la cellule sélectionnée
        ListColonNumSelected = Target.Column
        OngletName = ActiveSheet.Name
        '-----
        Select Case OngletName
            Case OngletListNews, OngletListFilms
                If FormFicheFilm_IsLoad Then Call WorksheetAction_FormFicheFilm
                If FormDataWebFilm_IsLoad And Not FormDataWebFilm_IsChangeInProgress Then Call WorksheetAction_FormDataWebFilm
                If FormDataWebActeur_IsLoad And Not FormDataWebActeur_IsChangeInProgress Then Call WorksheetAction_FormDataWebActeur
            Case OngletListActeur
                If FormDataWebActeur_IsLoad And Not FormDataWebActeur_IsChangeInProgress Then Call WorksheetAction_FormDataWebActeur
            Case OngletListVBC
                If FormProcView_IsLoad Then Call WorksheetAction_FormProcView
            Case Else
                Exit Sub
        End Select
    End Sub
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  9. #9
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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 )...

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

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

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

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

    un deuxième contrôle : quel est le form chargé ?
    souvenez vous le début du code de l’évènement UserForm_Initialize()
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
    Private Sub UserForm_Initialize()
        '-----
        Call VariableInitialyse
        Set objFormDataWebFilm = Me
        FormDataWebFilm_IsLoad = True
        '-------------------------------
        Me.ScrollBars = fmScrollBarsNone
    et bien , le contrôle est justement : If FormDataWebFilm_IsLoad ... (s'il est "True") ,
    mais pas seulement !! , il ne faut pas que le form soit en train de "travailler" : And Not FormDataWebFilm_IsChangeInProgress
    si tout est ...OK...alors la "Tour de Contrôle" aiguille vers une procédure (sub) spécialisée et spécifique pour cette situation
    Call WorksheetAction_FormDataWebFilm
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  10. #10
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
     
     
    '================================================================================================================================ WorksheetAction
    Public Sub WorksheetAction_FormDataWebFilm()
        'si ActiveCell -> Target  est dans le tableau xl
        If Not Application.Intersect(ListCelluleSelected, ActiveSheet.Range(ListColonDebut & ListLigneDebut & ":" & ListColonFin & ListLigneFinMax)) Is Nothing Then
            DataTitre = ActiveSheet.Range(ListColonTitre & ListLigneSelected).Value
            objFormDataWebFilm.Caption = DataTitre
            'objFormDataWebFilm.TxbDataRecherche.Value = DataTitre
            objFormDataWebFilm.Repaint
            Call DataFilmListEfface(objFormDataWebFilm)
            Call DataFilmWebEfface(objFormDataWebFilm)
            Call AfficheFormEfface(objFormDataWebFilm)
     
            Call DataFilmListLire(objFormDataWebFilm, ActiveSheet.Name, ListLigneSelected)
            Call DataFilmWebOption(objFormDataWebFilm)
            Call DataFilmAfficheDossier(objFormDataWebFilm)
     
            'attention...nouvelles..contraintes..!!!
            'recherche = Lcase , avec des num 0..9 relié par "-" , pas espace
            If FormDataWebFilm_IsNavigate Then
                Titre = Split(DataTitre, "(")(0)
                Titre = Trim(Titre)
                Titre = LCase(Titre)
                Titre = Replace(Titre, " - ", "-")
                Titre = Replace(Titre, " ", "-")
                Titre = Replace(Titre, "'", "-")
                WBAdress = "http://www.cinemotions.com/recherche/" & Titre
                'objFormDataWebFilm.Caption = WBAdress
                objWB.navigate (WBAdress)
            End If
        End If
    End Sub
    un dernier contrôle
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
        'si ActiveCell -> Target  est dans le tableau xl
        If Not Application.Intersect(ListCelluleSelected, ActiveSheet.Range(ListColonDebut & ListLigneDebut & ":" & ListColonFin & ListLigneFinMax)) Is Nothing Then
    ce contrôle consiste à vérifier si la cellule a été sélectionnée dans le périmètre du Tableau / DataBase
    le "double : Target" n'a pas été transmit , c'est pour cela qu'est utilisé l'autre "double : ListCelluleSelected"

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

    Pièce jointe 360340

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

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

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

    les appels qui suivent , vont être étudiés plus bas
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
            Call DataFilmListEfface(objFormDataWebFilm)
            Call DataFilmWebEfface(objFormDataWebFilm)
            Call AfficheFormEfface(objFormDataWebFilm)
     
            Call DataFilmListLire(objFormDataWebFilm, ActiveSheet.Name, ListLigneSelected)
            Call DataFilmWebOption(objFormDataWebFilm)
            Call DataFilmAfficheDossier(objFormDataWebFilm)
    une dernière vérification
    encore le bouton "Navigate"... If FormDataWebFilm_IsNavigate Then
    est ce que l' InterAction entre la Feuille et le Form est Activée ?

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

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

    Résultat

    Pièce jointe 360343

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

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

    Résultat

    Pièce jointe 360345

    la Fiche du Film ...

    voila pour la partie WEBBROWSER

    @+JP
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  11. #11
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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...

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

    Pièce jointe 360353

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

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

    Pièce jointe 360361

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

    soit : FormDataWebFilm.FrmPrincipal.FrmExtraire.FrmExtraireData.FrmData ... ...
    dans la réalité cette hiérarchie ne fonctionne pas !!?? ...
    c'est LE FORM qui contient TOUT 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 360366

    FrmExtraireData

    Pièce jointe 360368

    FrmData

    Pièce jointe 360371

    voila pour la structure , maintenant place au code
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  12. #12
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut Le Grand Ménage

    Bonjour,

    pour rappel , dans la procédure : WorksheetAction_FormDataWebFilm ,
    dans un premier temps on vidait les frames
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
     
            Call DataFilmListEfface(objFormDataWebFilm)
            Call DataFilmWebEfface(objFormDataWebFilm)
            Call AfficheFormEfface(objFormDataWebFilm)
    puis on chargeait les Data en provenance du PC
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
     
            Call DataFilmListLire(objFormDataWebFilm, ActiveSheet.Name, ListLigneSelected)
            Call DataFilmWebOption(objFormDataWebFilm)
            Call DataFilmAfficheDossier(objFormDataWebFilm)
    notez : que les TxtBox jaune sont liées au PC et celle transparente (gris clair) sont liées au Web

    Pièce jointe 360651

    donc Call DataFilmListEfface(objFormDataWebFilm) efface les "cases" jaunes
    le code qui suit efface les "cases" jaunes uniquement , mais , il les repositionne et repositionne aussi les "cases" gris clair et aussi les boutons et titres
    pour comprendre ce code:
    TxbMusiqueList ---> "case" jaune --> pc
    TxbMusique (sans list) --> "case" gris clair --> web
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
     
    Public Sub DataFilmListEfface(objForm As Object)
        FormDataWebFilm_IsChangeInProgress = True
        With objForm
            .TxbTitreList.Value = ""
            .TxbAliasList.Value = ""
            .TxbAnneeList.Value = ""
            .TxbGenreList.Value = ""
        End With
     
        With objForm
            With .TxbResumeList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblRealisateur.Top = .TxbResumeList.Top + .TxbResumeList.Height + 5
            .TxbRealisateur.Top = .LblRealisateur.Top + .LblRealisateur.Height + 5
            .OptionRealisateur.Top = .TxbRealisateur.Top + 2
            '-----
            .TxbRealisateurList.Top = .TxbRealisateur.Top + .TxbRealisateur.Height + 5
            .OptionRealisateurList.Top = .TxbRealisateurList.Top + 2
        End With
     
        With objForm
            With .TxbRealisateurList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblActeur.Top = .TxbRealisateurList.Top + .TxbRealisateurList.Height + 5
            .TxbActeur.Top = .LblActeur.Top + .LblActeur.Height + 5
            .OptionActeur.Top = .TxbActeur.Top + 2
            '-----
            .TxbActeurList.Top = .TxbActeur.Top + .TxbActeur.Height + 5
            .OptionActeurList.Top = .TxbActeurList.Top + 2
        End With
     
        With objForm
            With .TxbActeurList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblEcriture.Top = .TxbActeurList.Top + .TxbActeurList.Height + 5
            .TxbEcriture.Top = .LblEcriture.Top + .LblEcriture.Height + 5
            .OptionEcriture.Top = .TxbEcriture.Top + 2
            '-----
            .TxbEcritureList.Top = .TxbEcriture.Top + .TxbEcriture.Height + 5
            .OptionEcritureList.Top = .TxbEcritureList.Top + 2
        End With
        With objForm
            With .TxbEcritureList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblProduction.Top = .TxbEcritureList.Top + .TxbEcritureList.Height + 5
            .TxbProduction.Top = .LblProduction.Top + .LblProduction.Height + 5
            .OptionProduction.Top = .TxbProduction.Top + 2
            '-----
            .TxbProductionList.Top = .TxbProduction.Top + .TxbProduction.Height + 5
            .OptionProductionList.Top = .TxbProductionList.Top + 2
        End With
        With objForm
            With .TxbProductionList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblMontage.Top = .TxbProductionList.Top + .TxbProductionList.Height + 5
            .TxbMontage.Top = .LblMontage.Top + .LblMontage.Height + 5
            .OptionMontage.Top = .TxbMontage.Top + 2
            '-----
            .TxbMontageList.Top = .TxbMontage.Top + .TxbMontage.Height + 5
            .OptionMontageList.Top = .TxbMontageList.Top + 2
        End With
        With objForm
            With .TxbMontageList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblPhotographie.Top = .TxbMontageList.Top + .TxbMontageList.Height + 5
            .TxbPhotographie.Top = .LblPhotographie.Top + .LblPhotographie.Height + 5
            .OptionPhotographie.Top = .TxbPhotographie.Top + 2
            '-----
            .TxbPhotographieList.Top = .TxbPhotographie.Top + .TxbPhotographie.Height + 5
            .OptionPhotographieList.Top = .TxbPhotographieList.Top + 2
        End With
        With objForm
            With .TxbPhotographieList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblMusique.Top = .TxbPhotographieList.Top + .TxbPhotographieList.Height + 5
            .TxbMusique.Top = .LblMusique.Top + .LblMusique.Height + 5
            .OptionMusique.Top = .TxbMusique.Top + 2
            '-----
            .TxbMusiqueList.Top = .TxbMusique.Top + .TxbMusique.Height + 5
            .OptionMusiqueList.Top = .TxbMusiqueList.Top + 2
        End With
        With objForm
            With .TxbMusiqueList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblCostume.Top = .TxbMusiqueList.Top + .TxbMusiqueList.Height + 5
            .TxbCostume.Top = .LblCostume.Top + .LblCostume.Height + 5
            .OptionCostume.Top = .TxbCostume.Top + 2
            '-----
            .TxbCostumeList.Top = .TxbCostume.Top + .TxbCostume.Height + 5
            .OptionCostumeList.Top = .TxbCostumeList.Top + 2
        End With
        With objForm
            With .TxbCostumeList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblDecor.Top = .TxbCostumeList.Top + .TxbCostumeList.Height + 5
            .TxbDecor.Top = .LblDecor.Top + .LblDecor.Height + 5
            .OptionDecor.Top = .TxbDecor.Top + 2
            '-----
            .TxbDecorList.Top = .TxbDecor.Top + .TxbDecor.Height + 5
            .OptionDecorList.Top = .TxbDecorList.Top + 2
        End With
        With objForm
            With .TxbDecorList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblCasting.Top = .TxbDecorList.Top + .TxbDecorList.Height + 5
            .TxbCasting.Top = .LblCasting.Top + .LblCasting.Height + 5
            .OptionCasting.Top = .TxbCasting.Top + 2
            '-----
            .TxbCastingList.Top = .TxbCasting.Top + .TxbCasting.Height + 5
            .OptionCastingList.Top = .TxbCastingList.Top + 2
        End With
        With objForm
            With .TxbCastingList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblMaquillageCoiffure.Top = .TxbCastingList.Top + .TxbCastingList.Height + 5
            .TxbMaquillageCoiffure.Top = .LblMaquillageCoiffure.Top + .LblMaquillageCoiffure.Height + 5
            .OptionMaquillageCoiffure.Top = .TxbMaquillageCoiffure.Top + 2
            '-----
            .TxbMaquillageCoiffureList.Top = .TxbMaquillageCoiffure.Top + .TxbMaquillageCoiffure.Height + 5
            .OptionMaquillageCoiffureList.Top = .TxbMaquillageCoiffureList.Top + 2
        End With
        With objForm
            With .TxbMaquillageCoiffureList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblDirectionArtistique.Top = .TxbMaquillageCoiffureList.Top + .TxbMaquillageCoiffureList.Height + 5
            .TxbDirectionArtistique.Top = .LblDirectionArtistique.Top + .LblDirectionArtistique.Height + 5
            .OptionDirectionArtistique.Top = .TxbDirectionArtistique.Top + 2
            '-----
            .TxbDirectionArtistiqueList.Top = .TxbDirectionArtistique.Top + .TxbDirectionArtistique.Height + 5
            .OptionDirectionArtistiqueList.Top = .TxbDirectionArtistiqueList.Top + 2
        End With
        With objForm
            With .TxbDirectionArtistiqueList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblChefDecoration.Top = .TxbDirectionArtistiqueList.Top + .TxbDirectionArtistiqueList.Height + 5
            .TxbChefDecoration.Top = .LblChefDecoration.Top + .LblChefDecoration.Height + 5
            .OptionChefDecoration.Top = .TxbChefDecoration.Top + 2
            '-----
            .TxbChefDecorationList.Top = .TxbChefDecoration.Top + .TxbChefDecoration.Height + 5
            .OptionChefDecorationList.Top = .TxbChefDecorationList.Top + 2
        End With
        With objForm
            With .TxbChefDecorationList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblAssistantRealisation.Top = .TxbChefDecorationList.Top + .TxbChefDecorationList.Height + 5
            .TxbAssistantRealisation.Top = .LblAssistantRealisation.Top + .LblAssistantRealisation.Height + 5
            .OptionAssistantRealisation.Top = .TxbAssistantRealisation.Top + 2
            '-----
            .TxbAssistantRealisationList.Top = .TxbAssistantRealisation.Top + .TxbAssistantRealisation.Height + 5
            .OptionAssistantRealisationList.Top = .TxbAssistantRealisationList.Top + 2
        End With
        With objForm
            With .TxbAssistantRealisationList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblSon.Top = .TxbAssistantRealisationList.Top + .TxbAssistantRealisationList.Height + 5
            .TxbSon.Top = .LblSon.Top + .LblSon.Height + 5
            .OptionSon.Top = .TxbSon.Top + 2
            '-----
            .TxbSonList.Top = .TxbSon.Top + .TxbSon.Height + 5
            .OptionSonList.Top = .TxbSonList.Top + 2
        End With
        With objForm
            With .TxbSonList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblEffetsSpeciaux.Top = .TxbSonList.Top + .TxbSonList.Height + 5
            .TxbEffetsSpeciaux.Top = .LblEffetsSpeciaux.Top + .LblEffetsSpeciaux.Height + 5
            .OptionEffetsSpeciaux.Top = .TxbEffetsSpeciaux.Top + 2
            '-----
            .TxbEffetsSpeciauxList.Top = .TxbEffetsSpeciaux.Top + .TxbEffetsSpeciaux.Height + 5
            .OptionEffetsSpeciauxList.Top = .TxbEffetsSpeciauxList.Top + 2
        End With
        With objForm
            With .TxbEffetsSpeciauxList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .LblDirectionProduction.Top = .TxbEffetsSpeciauxList.Top + .TxbEffetsSpeciauxList.Height + 5
            .TxbDirectionProduction.Top = .LblDirectionProduction.Top + .LblDirectionProduction.Height + 5
            .OptionDirectionProduction.Top = .TxbDirectionProduction.Top + 2
            '-----
            .TxbDirectionProductionList.Top = .TxbDirectionProduction.Top + .TxbDirectionProduction.Height + 5
            .OptionDirectionProductionList.Top = .TxbDirectionProductionList.Top + 2
        End With
        With objForm
            With .TxbDirectionProductionList
                .Value = ""
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
        End With
        With objForm
            .FrmExtraireData.ScrollHeight = .TxbDirectionProductionList.Top + .TxbDirectionProductionList.Height + 5
            .FrmExtraireData.ScrollTop = 0
            .FrmData.Height = .FrmExtraireData.ScrollHeight
        End With
        FormDataWebFilm_IsChangeInProgress = False
    End Sub
    aprés les "cases" jaunes , effacer les "cases" gris clair avec : Call DataFilmWebEfface(objFormDataWebFilm)
    on pourrait penser que le code est identique ... mais non
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
     
    Public Sub DataFilmWebEfface(objForm As Object)
        FormDataWebFilm_IsChangeInProgress = True
        With objForm
            .TxbTitre.Value = ""
            .TxbAlias.Value = ""
            .TxbAnnee.Value = ""
            .TxbGenre.Value = ""
        End With
        With objForm
            With .TxbResume
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbResumeList.Top = .TxbResume.Top + .TxbResume.Height + 5
            .OptionResumeList.Top = .TxbResumeList.Top + 2
        End With
        With objForm
            .LblRealisateur.Top = .TxbResumeList.Top + .TxbResumeList.Height + 5
            .TxbRealisateur.Top = .LblRealisateur.Top + .LblRealisateur.Height + 5
            .OptionRealisateur.Top = .TxbRealisateur.Top + 2
            With .TxbRealisateur
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbRealisateurList.Top = .TxbRealisateur.Top + .TxbRealisateur.Height + 5
            .OptionRealisateurList.Top = .TxbRealisateurList.Top + 2
        End With
     
        With objForm
            .LblActeur.Top = .TxbRealisateurList.Top + .TxbRealisateurList.Height + 5
            .TxbActeur.Top = .LblActeur.Top + .LblActeur.Height + 5
            .OptionActeur.Top = .TxbActeur.Top + 2
            With .TxbActeur
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbActeurList.Top = .TxbActeur.Top + .TxbActeur.Height + 5
            .OptionActeurList.Top = .TxbActeurList.Top + 2
        End With
        With objForm
            .LblEcriture.Top = .TxbActeurList.Top + .TxbActeurList.Height + 5
            .TxbEcriture.Top = .LblEcriture.Top + .LblEcriture.Height + 5
            .OptionEcriture.Top = .TxbEcriture.Top + 2
            '-----
            With .TxbEcriture
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbEcritureList.Top = .TxbEcriture.Top + .TxbEcriture.Height + 5
            .OptionEcritureList.Top = .TxbEcritureList.Top + 2
        End With
        With objForm
            .LblProduction.Top = .TxbEcritureList.Top + .TxbEcritureList.Height + 5
            .TxbProduction.Top = .LblProduction.Top + .LblProduction.Height + 5
            .OptionProduction.Top = .TxbProduction.Top + 2
            With .TxbProduction
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbProductionList.Top = .TxbProduction.Top + .TxbProduction.Height + 5
            .OptionProductionList.Top = .TxbProductionList.Top + 2
        End With
        With objForm
            .LblMontage.Top = .TxbProductionList.Top + .TxbProductionList.Height + 5
            .TxbMontage.Top = .LblMontage.Top + .LblMontage.Height + 5
            .OptionMontage.Top = .TxbMontage.Top + 2
            With .TxbMontage
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbMontageList.Top = .TxbMontage.Top + .TxbMontage.Height + 5
            .OptionMontageList.Top = .TxbMontageList.Top + 2
        End With
        With objForm
            .LblPhotographie.Top = .TxbMontageList.Top + .TxbMontageList.Height + 5
            .TxbPhotographie.Top = .LblPhotographie.Top + .LblPhotographie.Height + 5
            .OptionPhotographie.Top = .TxbPhotographie.Top + 2
            With .TxbPhotographie
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbPhotographieList.Top = .TxbPhotographie.Top + .TxbPhotographie.Height + 5
            .OptionPhotographieList.Top = .TxbPhotographieList.Top + 2
        End With
        With objForm
            .LblMusique.Top = .TxbPhotographieList.Top + .TxbPhotographieList.Height + 5
            .TxbMusique.Top = .LblMusique.Top + .LblMusique.Height + 5
            .OptionMusique.Top = .TxbMusique.Top + 2
            With .TxbMusique
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbMusiqueList.Top = .TxbMusique.Top + .TxbMusique.Height + 5
            .OptionMusiqueList.Top = .TxbMusiqueList.Top + 2
        End With
        With objForm
            .LblCostume.Top = .TxbMusiqueList.Top + .TxbMusiqueList.Height + 5
            .TxbCostume.Top = .LblCostume.Top + .LblCostume.Height + 5
            .OptionCostume.Top = .TxbCostume.Top + 2
            With .TxbCostume
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbCostumeList.Top = .TxbCostume.Top + .TxbCostume.Height + 5
            .OptionCostumeList.Top = .TxbCostumeList.Top + 2
        End With
        With objForm
            .LblDecor.Top = .TxbCostumeList.Top + .TxbCostumeList.Height + 5
            .TxbDecor.Top = .LblDecor.Top + .LblDecor.Height + 5
            .OptionDecor.Top = .TxbDecor.Top + 2
            With .TxbDecor
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbDecorList.Top = .TxbDecor.Top + .TxbDecor.Height + 5
            .OptionDecorList.Top = .TxbDecorList.Top + 2
        End With
        With objForm
            .LblCasting.Top = .TxbDecorList.Top + .TxbDecorList.Height + 5
            .TxbCasting.Top = .LblCasting.Top + .LblCasting.Height + 5
            .OptionCasting.Top = .TxbCasting.Top + 2
            With .TxbCasting
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbCastingList.Top = .TxbCasting.Top + .TxbCasting.Height + 5
            .OptionCastingList.Top = .TxbCastingList.Top + 2
        End With
        With objForm
            .LblMaquillageCoiffure.Top = .TxbCastingList.Top + .TxbCastingList.Height + 5
            .TxbMaquillageCoiffure.Top = .LblMaquillageCoiffure.Top + .LblMaquillageCoiffure.Height + 5
            .OptionMaquillageCoiffure.Top = .TxbMaquillageCoiffure.Top + 2
            With .TxbMaquillageCoiffure
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbMaquillageCoiffureList.Top = .TxbMaquillageCoiffure.Top + .TxbMaquillageCoiffure.Height + 5
            .OptionMaquillageCoiffureList.Top = .TxbMaquillageCoiffureList.Top + 2
        End With
        With objForm
            .LblDirectionArtistique.Top = .TxbMaquillageCoiffureList.Top + .TxbMaquillageCoiffureList.Height + 5
            .TxbDirectionArtistique.Top = .LblDirectionArtistique.Top + .LblDirectionArtistique.Height + 5
            .OptionDirectionArtistique.Top = .TxbDirectionArtistique.Top + 2
            With .TxbDirectionArtistique
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbDirectionArtistiqueList.Top = .TxbDirectionArtistique.Top + .TxbDirectionArtistique.Height + 5
            .OptionDirectionArtistiqueList.Top = .TxbDirectionArtistiqueList.Top + 2
        End With
        With objForm
            .LblChefDecoration.Top = .TxbDirectionArtistiqueList.Top + .TxbDirectionArtistiqueList.Height + 5
            .TxbChefDecoration.Top = .LblChefDecoration.Top + .LblChefDecoration.Height + 5
            .OptionChefDecoration.Top = .TxbChefDecoration.Top + 2
            With .TxbChefDecoration
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbChefDecorationList.Top = .TxbChefDecoration.Top + .TxbChefDecoration.Height + 5
            .OptionChefDecorationList.Top = .TxbChefDecorationList.Top + 2
        End With
        With objForm
            .LblAssistantRealisation.Top = .TxbChefDecorationList.Top + .TxbChefDecorationList.Height + 5
            .TxbAssistantRealisation.Top = .LblAssistantRealisation.Top + .LblAssistantRealisation.Height + 5
            .OptionAssistantRealisation.Top = .TxbAssistantRealisation.Top + 2
            With .TxbAssistantRealisation
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbAssistantRealisationList.Top = .TxbAssistantRealisation.Top + .TxbAssistantRealisation.Height + 5
            .OptionAssistantRealisationList.Top = .TxbAssistantRealisationList.Top + 2
        End With
        With objForm
            .LblSon.Top = .TxbAssistantRealisationList.Top + .TxbAssistantRealisationList.Height + 5
            .TxbSon.Top = .LblSon.Top + .LblSon.Height + 5
            .OptionSon.Top = .TxbSon.Top + 2
            With .TxbSon
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbSonList.Top = .TxbSon.Top + .TxbSon.Height + 5
            .OptionSonList.Top = .TxbSonList.Top + 2
        End With
        With objForm
            .LblEffetsSpeciaux.Top = .TxbSonList.Top + .TxbSonList.Height + 5
            .TxbEffetsSpeciaux.Top = .LblEffetsSpeciaux.Top + .LblEffetsSpeciaux.Height + 5
            .OptionEffetsSpeciaux.Top = .TxbEffetsSpeciaux.Top + 2
            With .TxbEffetsSpeciaux
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbEffetsSpeciauxList.Top = .TxbEffetsSpeciaux.Top + .TxbEffetsSpeciaux.Height + 5
            .OptionEffetsSpeciauxList.Top = .TxbEffetsSpeciauxList.Top + 2
        End With
        With objForm
            .LblDirectionProduction.Top = .TxbEffetsSpeciauxList.Top + .TxbEffetsSpeciauxList.Height + 5
            .TxbDirectionProduction.Top = .LblDirectionProduction.Top + .LblDirectionProduction.Height + 5
            .OptionDirectionProduction.Top = .TxbDirectionProduction.Top + 2
            With .TxbDirectionProduction
                .Value = ""
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                .Height = 14
            End With
            .TxbDirectionProductionList.Top = .TxbDirectionProduction.Top + .TxbDirectionProduction.Height + 5
            .OptionDirectionProductionList.Top = .TxbDirectionProductionList.Top + 2
        End With
        With objForm
            .FrmExtraireData.ScrollHeight = .TxbDirectionProductionList.Top + .TxbDirectionProductionList.Height + 5
            .FrmExtraireData.ScrollTop = 0
            .FrmData.Height = .FrmExtraireData.ScrollHeight
        End With
        FormDataWebFilm_IsChangeInProgress = False
    End Sub
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  13. #13
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
     
    Public DataSheetList As String
    Public DataLigneList As Single
    Public Sub DataFilmListLire(objForm As Object, ByVal SheetName As String, ByVal Ligne As Single)
        FormDataWebFilm_IsChangeInProgress = True
        DataSheetList = SheetName
        DataLigneList = Ligne
        With objForm.TxbTitreList
            .Value = Sheets(SheetName).Cells(Ligne, ListColonNumTitre).Value
        End With
        With objForm.TxbAliasList
            .Value = Sheets(SheetName).Cells(Ligne, ListColonNumAlias).Value
            If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
        End With
        With objForm.TxbAnneeList
            .Value = Sheets(SheetName).Cells(Ligne, ListColonNumAnnee).Value
        End With
        With objForm.TxbGenreList
            .Value = Sheets(SheetName).Cells(Ligne, ListColonNumGenre).Value
        End With
        With objForm
            With .TxbResumeList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumResume).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                ''.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblRealisateur.Top = .TxbResumeList.Top + .TxbResumeList.Height + 5
            .TxbRealisateur.Top = .LblRealisateur.Top + .LblRealisateur.Height + 5
            .OptionRealisateur.Top = .TxbRealisateur.Top + 2
            '-----
            .TxbRealisateurList.Top = .TxbRealisateur.Top + .TxbRealisateur.Height + 5
            .OptionRealisateurList.Top = .TxbRealisateurList.Top + 2
        End With
        With objForm
            With .TxbRealisateurList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumRealisateur).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblActeur.Top = .TxbRealisateurList.Top + .TxbRealisateurList.Height + 5
            .TxbActeur.Top = .LblActeur.Top + .LblActeur.Height + 5
            .OptionActeur.Top = .TxbActeur.Top + 2
            '-----
            .TxbActeurList.Top = .TxbActeur.Top + .TxbActeur.Height + 5
            .OptionActeurList.Top = .TxbActeurList.Top + 2
        End With
        With objForm
            With .TxbActeurList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumActeur).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblEcriture.Top = .TxbActeurList.Top + .TxbActeurList.Height + 5
            .TxbEcriture.Top = .LblEcriture.Top + .LblEcriture.Height + 5
            .OptionEcriture.Top = .TxbEcriture.Top + 2
            '-----
            .TxbEcritureList.Top = .TxbEcriture.Top + .TxbEcriture.Height + 5
            .OptionEcritureList.Top = .TxbEcritureList.Top + 2
        End With
        With objForm
            With .TxbEcritureList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumEcriture).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblProduction.Top = .TxbEcritureList.Top + .TxbEcritureList.Height + 5
            .TxbProduction.Top = .LblProduction.Top + .LblProduction.Height + 5
            .OptionProduction.Top = .TxbProduction.Top + 2
            '-----
            .TxbProductionList.Top = .TxbProduction.Top + .TxbProduction.Height + 5
            .OptionProductionList.Top = .TxbProductionList.Top + 2
        End With
        With objForm
            With .TxbProductionList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumProduction).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblMontage.Top = .TxbProductionList.Top + .TxbProductionList.Height + 5
            .TxbMontage.Top = .LblMontage.Top + .LblMontage.Height + 5
            .OptionMontage.Top = .TxbMontage.Top + 2
            '-----
            .TxbMontageList.Top = .TxbMontage.Top + .TxbMontage.Height + 5
            .OptionMontageList.Top = .TxbMontageList.Top + 2
        End With
        With objForm
            With .TxbMontageList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumMontage).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblPhotographie.Top = .TxbMontageList.Top + .TxbMontageList.Height + 5
            .TxbPhotographie.Top = .LblPhotographie.Top + .LblPhotographie.Height + 5
            .OptionPhotographie.Top = .TxbPhotographie.Top + 2
            '-----
            .TxbPhotographieList.Top = .TxbPhotographie.Top + .TxbPhotographie.Height + 5
            .OptionPhotographieList.Top = .TxbPhotographieList.Top + 2
        End With
        With objForm
            With .TxbPhotographieList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumPhotographie).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblMusique.Top = .TxbPhotographieList.Top + .TxbPhotographieList.Height + 5
            .TxbMusique.Top = .LblMusique.Top + .LblMusique.Height + 5
            .OptionMusique.Top = .TxbMusique.Top + 2
            '-----
            .TxbMusiqueList.Top = .TxbMusique.Top + .TxbMusique.Height + 5
            .OptionMusiqueList.Top = .TxbMusiqueList.Top + 2
        End With
        With objForm
            With .TxbMusiqueList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumMusique).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            '-----
            .LblCostume.Top = .TxbMusiqueList.Top + .TxbMusiqueList.Height + 5
            .TxbCostume.Top = .LblCostume.Top + .LblCostume.Height + 5
            .OptionCostume.Top = .TxbCostume.Top + 2
            '-----
            .TxbCostumeList.Top = .TxbCostume.Top + .TxbCostume.Height + 5
            .OptionCostumeList.Top = .TxbCostumeList.Top + 2
        End With
        With objForm
            With .TxbCostumeList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumCostume).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblDecor.Top = .TxbCostumeList.Top + .TxbCostumeList.Height + 5
            .TxbDecor.Top = .LblDecor.Top + .LblDecor.Height + 5
            .OptionDecor.Top = .TxbDecor.Top + 2
            '-----
            .TxbDecorList.Top = .TxbDecor.Top + .TxbDecor.Height + 5
            .OptionDecorList.Top = .TxbDecorList.Top + 2
        End With
        With objForm
            With .TxbDecorList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumDecor).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblCasting.Top = .TxbDecorList.Top + .TxbDecorList.Height + 5
            .TxbCasting.Top = .LblCasting.Top + .LblCasting.Height + 5
            .OptionCasting.Top = .TxbCasting.Top + 2
            '-----
            .TxbCastingList.Top = .TxbCasting.Top + .TxbCasting.Height + 5
            .OptionCastingList.Top = .TxbCastingList.Top + 2
        End With
        With objForm
            With .TxbCastingList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumCasting).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblMaquillageCoiffure.Top = .TxbCastingList.Top + .TxbCastingList.Height + 5
            .TxbMaquillageCoiffure.Top = .LblMaquillageCoiffure.Top + .LblMaquillageCoiffure.Height + 5
            .OptionMaquillageCoiffure.Top = .TxbMaquillageCoiffure.Top + 2
            '-----
            .TxbMaquillageCoiffureList.Top = .TxbMaquillageCoiffure.Top + .TxbMaquillageCoiffure.Height + 5
            .OptionMaquillageCoiffureList.Top = .TxbMaquillageCoiffureList.Top + 2
        End With
        With objForm
            With .TxbMaquillageCoiffureList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumMaquillageCoiffure).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblDirectionArtistique.Top = .TxbMaquillageCoiffureList.Top + .TxbMaquillageCoiffureList.Height + 5
            .TxbDirectionArtistique.Top = .LblDirectionArtistique.Top + .LblDirectionArtistique.Height + 5
            .OptionDirectionArtistique.Top = .TxbDirectionArtistique.Top + 2
            '-----
            .TxbDirectionArtistiqueList.Top = .TxbDirectionArtistique.Top + .TxbDirectionArtistique.Height + 5
            .OptionDirectionArtistiqueList.Top = .TxbDirectionArtistiqueList.Top + 2
        End With
        With objForm
            With .TxbDirectionArtistiqueList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumDirectionArtistique).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblChefDecoration.Top = .TxbDirectionArtistiqueList.Top + .TxbDirectionArtistiqueList.Height + 5
            .TxbChefDecoration.Top = .LblChefDecoration.Top + .LblChefDecoration.Height + 5
            .OptionChefDecoration.Top = .TxbChefDecoration.Top + 2
            '-----
            .TxbChefDecorationList.Top = .TxbChefDecoration.Top + .TxbChefDecoration.Height + 5
            .OptionChefDecorationList.Top = .TxbChefDecorationList.Top + 2
        End With
        With objForm
            With .TxbChefDecorationList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumChefDecoration).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblAssistantRealisation.Top = .TxbChefDecorationList.Top + .TxbChefDecorationList.Height + 5
            .TxbAssistantRealisation.Top = .LblAssistantRealisation.Top + .LblAssistantRealisation.Height + 5
            .OptionAssistantRealisation.Top = .TxbAssistantRealisation.Top + 2
            '-----
            .TxbAssistantRealisationList.Top = .TxbAssistantRealisation.Top + .TxbAssistantRealisation.Height + 5
            .OptionAssistantRealisationList.Top = .TxbAssistantRealisationList.Top + 2
        End With
        With objForm
            With .TxbAssistantRealisationList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumAssistantRealisation).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblSon.Top = .TxbAssistantRealisationList.Top + .TxbAssistantRealisationList.Height + 5
            .TxbSon.Top = .LblSon.Top + .LblSon.Height + 5
            .OptionSon.Top = .TxbSon.Top + 2
            '-----
            .TxbSonList.Top = .TxbSon.Top + .TxbSon.Height + 5
            .OptionSonList.Top = .TxbSonList.Top + 2
        End With
        With objForm
            With .TxbSonList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumSon).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblEffetsSpeciaux.Top = .TxbSonList.Top + .TxbSonList.Height + 5
            .TxbEffetsSpeciaux.Top = .LblEffetsSpeciaux.Top + .LblEffetsSpeciaux.Height + 5
            .OptionEffetsSpeciaux.Top = .TxbEffetsSpeciaux.Top + 2
            '-----
            .TxbEffetsSpeciauxList.Top = .TxbEffetsSpeciaux.Top + .TxbEffetsSpeciaux.Height + 5
            .OptionEffetsSpeciauxList.Top = .TxbEffetsSpeciauxList.Top + 2
        End With
        With objForm
            With .TxbEffetsSpeciauxList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumEffetsSpeciaux).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
            .LblDirectionProduction.Top = .TxbEffetsSpeciauxList.Top + .TxbEffetsSpeciauxList.Height + 5
            .TxbDirectionProduction.Top = .LblDirectionProduction.Top + .LblDirectionProduction.Height + 5
            .OptionDirectionProduction.Top = .TxbDirectionProduction.Top + 2
            '-----
            .TxbDirectionProductionList.Top = .TxbDirectionProduction.Top + .TxbDirectionProduction.Height + 5
            .OptionDirectionProductionList.Top = .TxbDirectionProductionList.Top + 2
        End With
        With objForm
            With .TxbDirectionProductionList
                .Value = Trim(Sheets(SheetName).Cells(Ligne, ListColonNumDirectionProduction).Value)
                If Right(.Value, 1) = ";" Then .Value = Left(.Value, Len(.Value) - 1)
                .Width = 490
                '.Font = "Tahoma"
                .Font.Size = "8"
                '-----
                .SetFocus
                If .LineCount > 1 Then
                    .Height = (.Font.Size + 4) * .LineCount
                Else
                    .Height = 14
                End If
            End With
        End With
        With objForm
            .FrmExtraireData.ScrollHeight = .TxbDirectionProductionList.Top + .TxbDirectionProductionList.Height + 5
            .FrmExtraireData.ScrollTop = 0
            .FrmData.Height = .FrmExtraireData.ScrollHeight
        End With
        FormDataWebFilm_IsChangeInProgress = False
    End Sub
    à ce stade , le code a écrit dans les "cases" jaunes , les "cases" gris clair sont vides et tout est ordonné ,
    l'appel à : Call DataFilmWebOption(objFormDataWebFilm) va gérer les "OptionButton" (bouton radio)...
    le code va comparer la longueur du contenu des "cases" jaunes et gris clair et va activer l' "OptionButton" pour les arbitrages supérieurs
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
     
    Public Sub DataFilmWebOption(objForm As Object)
        FormDataWebFilm_IsChangeInProgress = True
        With objForm
            .OptionTitreList.Value = True
            .OptionAliasList.Value = True
            .OptionAnneeList.Value = True
            .OptionGenreList.Value = True
            .OptionResumeList.Value = True
            .OptionRealisateurList.Value = True
            .OptionActeurList.Value = True
            .OptionEcritureList.Value = True
            .OptionProductionList.Value = True
            .OptionMontageList.Value = True
            .OptionPhotographieList.Value = True
            .OptionMusiqueList.Value = True
            .OptionCostumeList.Value = True
            .OptionDecorList.Value = True
            .OptionCastingList.Value = True
            .OptionMaquillageCoiffureList.Value = True
            .OptionDirectionArtistiqueList.Value = True
            .OptionChefDecorationList.Value = True
            .OptionAssistantRealisationList.Value = True
            .OptionSonList.Value = True
            .OptionEffetsSpeciauxList.Value = True
            .OptionDirectionProductionList.Value = True
        End With
        With objForm
            If Len(.TxbTitre.Value) > Len(.TxbTitreList) Then .OptionTitre.Value = True
            If Len(.TxbAlias.Value) > Len(.TxbAliasList) Then .OptionAlias.Value = True
            If Len(.TxbAnnee.Value) > Len(.TxbAnneeList) Then .OptionAnnee.Value = True
            'If Len(.TxbGenre.Value) > Len(.TxbGenreList) Then .OptionGenre.Value = True
            If Len(.TxbResume.Value) > Len(.TxbResumeList) Then .OptionResume.Value = True
            If Len(.TxbRealisateur.Value) > Len(.TxbRealisateurList) Then .OptionRealisateur.Value = True
            If Len(.TxbActeur.Value) > Len(.TxbActeurList) Then .OptionActeur.Value = True
            If Len(.TxbEcriture.Value) > Len(.TxbEcritureList) Then .OptionEcriture.Value = True
            If Len(.TxbProduction.Value) > Len(.TxbProductionList) Then .OptionProduction.Value = True
            If Len(.TxbMontage.Value) > Len(.TxbMontageList) Then .OptionMontage.Value = True
            If Len(.TxbPhotographie.Value) > Len(.TxbPhotographieList) Then .OptionPhotographie.Value = True
            If Len(.TxbMusique.Value) > Len(.TxbMusiqueList) Then .OptionMusique.Value = True
            If Len(.TxbCostume.Value) > Len(.TxbCostumeList) Then .OptionCostume.Value = True
            If Len(.TxbDecor.Value) > Len(.TxbDecorList) Then .OptionDecor.Value = True
            If Len(.TxbCasting.Value) > Len(.TxbCastingList) Then .OptionCasting.Value = True
            If Len(.TxbMaquillageCoiffure.Value) > Len(.TxbMaquillageCoiffureList) Then .OptionMaquillageCoiffure.Value = True
            If Len(.TxbDirectionArtistique.Value) > Len(.TxbDirectionArtistiqueList) Then .OptionDirectionArtistique.Value = True
            If Len(.TxbChefDecoration.Value) > Len(.TxbChefDecorationList) Then .OptionChefDecoration.Value = True
            If Len(.TxbAssistantRealisation.Value) > Len(.TxbAssistantRealisationList) Then .OptionAssistantRealisation.Value = True
            If Len(.TxbSon.Value) > Len(.TxbSonList) Then .OptionSon.Value = True
            If Len(.TxbEffetsSpeciaux.Value) > Len(.TxbEffetsSpeciauxList) Then .OptionEffetsSpeciaux.Value = True
            If Len(.TxbDirectionProduction.Value) > Len(.TxbDirectionProductionList) Then .OptionDirectionProduction.Value = True
        End With
        FormDataWebFilm_IsChangeInProgress = False
    End Sub
    voila pour cette première partie qui consiste à charger les Data du PC ,

    Pièce jointe 360375

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

    Pièce jointe 360376

    maintenant il faut aller chercher les Data sur le Web...
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  14. #14
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
     
    '===================================================================== Extraire
    '------------------------------------------------------- Btn Extraire
    Private Sub LblExtraire_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblExtraire.SpecialEffect = fmSpecialEffectSunken
    End Sub
    Private Sub LblExtraire_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Me.LblExtraire.SpecialEffect = fmSpecialEffectRaised
    End Sub
    Private Sub LblExtraire_Click()
        If Me.LblExtraire.BackColor = &H80000002 Then
            'ferme
            Me.LblExtraire.BackColor = &H8000000F 'normal
        Else
            'ouvre
            Me.LblExtraire.BackColor = &H80000002 'actif
            'action
            FormDataWebFilm_IsChangeInProgress = True
            '-----
            Call DataFilmWebExtraire(objFormDataWebFilm)
            Call DataFilmWebOrganiser
            Call DataFilmWebEfface(objFormDataWebFilm)
            Call DataFilmWebLire(objFormDataWebFilm)
            Call DataFilmWebOption(objFormDataWebFilm)
            '----- efface affiche
            Call AfficheFormEffaceWeb(objFormDataWebFilm)
            Call DataFilmAfficheWeb(objFormDataWebFilm)
            Call AffichesPageWeb(objFormDataWebFilm)
            '-----
            FormDataWebFilm_IsChangeInProgress = False
            'bouton
            Me.LblExtraire.BackColor = &H8000000F 'normal
        End If
    End Sub
    donc , on commence par extraire les "DataWeb" avec : Call DataFilmWebExtraire(objFormDataWebFilm)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
     
    Public objWB As SHDocVw.WebBrowser
    Public objDoc As MSHTML.HTMLDocument
    Public TabDataHTML() As String
    Public TabDataFilm() As String
    Public Sub DataFilmWebExtraire(objForm As Object)
        'dimensionne et efface
        ReDim TabDataHTML(2000)
        ReDim TabDataFilm(1000)
        '-----
        'READYSTATE_UNINITIALIZED = 0
        'READYSTATE_LOADING = 1
        'READYSTATE_LOADED = 2
        'READYSTATE_INTERACTIVE = 3
        'READYSTATE_COMPLETE = 4
        'On boucle tant que la page n'est pas totalement chargée
        'pTimeOut est un time out en secondes (WaitIE vaut True si Timeout)
        Dim lTimer As Double
        lTimer = Timer
        pTimeOut = 2
        Do
            DoEvents
            If objWB.readyState = READYSTATE_COMPLETE And Not objWB.Busy Then Exit Do
            If pTimeOut > 0 And Timer - lTimer > pTimeOut Then Exit Do
        Loop
        '-----
        ' Page chargée, on continue
        Set objDoc = objWB.document
        '-----
        Ligne = 1
        Set DataH = objDoc.getElementsByTagName("head")
        For n = 1 To DataH(0).all.Length - 1
            TabDataHTML(Ligne) = DataH(0).all(n).outerHTML
            Ligne = Ligne + 1
        Next n
        Set DataTab = objDoc.getElementsByTagName("table")
        For n = 1 To DataTab.Length - 1
            Set DataTD = DataTab(n).getElementsByTagName("td")
            For n2 = 1 To DataTD.Length - 1
                TabDataHTML(Ligne) = DataTD(n2).innerHTML
                Ligne = Ligne + 1
            Next n2
        Next n
        '-----
        Ligne = 0
        'LigneFin = Range("b" & Rows.Count).End(xlUp).Row
        LigneFin = UBound(TabDataHTML)
        '----- description
        DataElement = objDoc.getElementsByName("description")
        TabElement = Split(DataElement.Content, "-")
        '-----
        If InStr(TabElement(0), "(") > 0 Then
            Titre = Trim(FormatTitre(Split(TabElement(0), "(")(0)))
            Alias = Trim(FormatTitre(Replace(Split(TabElement(0), "(")(1), ")", "")))
        Else
            Titre = Trim(FormatTitre(TabElement(0)))
            Alias = ""
        End If
        'titre
        DataLigne = "Titre"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Trim(TabElement(0))
        DataLigne = DataLigne & "|" & Titre
        Ligne = 1: TabDataFilm(Ligne) = DataLigne
        'alias
        DataLigne = "Alias"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Trim(TabElement(0))
        DataLigne = DataLigne & "|" & Alias
        Ligne = 2: TabDataFilm(Ligne) = DataLigne
        'année
        DataLigne = "Année"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Trim(TabElement(1))
        DataLigne = DataLigne & "|" & Trim(TabElement(1))
        Ligne = 3: TabDataFilm(Ligne) = DataLigne
        'genre
        If InStr(LCase(TabElement(2)), "science") > 0 Then
            DataGenre = "Science-Fiction"
        Else
            DataGenre = Trim(TabElement(2))
        End If
        DataLigne = "Genre"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Trim(TabElement(2))
        DataLigne = DataLigne & "|" & DataGenre
        Ligne = 4: TabDataFilm(Ligne) = DataLigne
        'résumé / synopsis
        Set DataSpan = objDoc.getElementsByTagName("span")
        For n = 1 To 200
            If InStr(LCase(DataSpan(n).outerHTML), "description") > 0 Then
                DataResume = Trim(Replace(Replace(DataSpan(n).outerText, vbCrLf, ""), "|", ":"))
                Exit For
            End If
        Next n
        DataLigne = "Résumé"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & DataSpan(n).outerText
        DataLigne = DataLigne & "|" & DataResume
        Ligne = 5: TabDataFilm(Ligne) = DataLigne
        '-----
        'réalisation
        DataLigne = "Réalisateur"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 6: TabDataFilm(Ligne) = DataLigne
        'interprétation
        DataLigne = "Acteur"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 7: TabDataFilm(Ligne) = DataLigne
        'ecriture
        DataLigne = "Ecriture"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 8: TabDataFilm(Ligne) = DataLigne
        'production
        DataLigne = "Production"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 9: TabDataFilm(Ligne) = DataLigne
        'montage
        DataLigne = "Montage"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 10: TabDataFilm(Ligne) = DataLigne
        'photographie
        DataLigne = "Photographie"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 11: TabDataFilm(Ligne) = DataLigne
        'musique
        DataLigne = "Musique"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 12: TabDataFilm(Ligne) = DataLigne
        'costumes
        DataLigne = "Costumes"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 13: TabDataFilm(Ligne) = DataLigne
        'décors
        DataLigne = "Décors"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 14: TabDataFilm(Ligne) = DataLigne
        'casting
        DataLigne = "Casting"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 15: TabDataFilm(Ligne) = DataLigne
        'maquillage_coiffure
        DataLigne = "Maquillage_Coiffure"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 16: TabDataFilm(Ligne) = DataLigne
        'direction artistique
        DataLigne = "Direction Artistique"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 17: TabDataFilm(Ligne) = DataLigne
        'chef décoration
        DataLigne = "Chef Décoration"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 18: TabDataFilm(Ligne) = DataLigne
        'assistant réalisation
        DataLigne = "Assistant Réalisation"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 19: TabDataFilm(Ligne) = DataLigne
        'son
        DataLigne = "Son"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 20: TabDataFilm(Ligne) = DataLigne
        'effets spéciaux
        DataLigne = "Effets Spéciaux"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 21: TabDataFilm(Ligne) = DataLigne
        'direction de production
        DataLigne = "Direction Production"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 22: TabDataFilm(Ligne) = DataLigne
        'durée
        DataLigne = "Durée"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
        Ligne = 23: TabDataFilm(Ligne) = DataLigne
        'CD Total
        DataLigne = "CD Total"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
        Ligne = 24: TabDataFilm(Ligne) = DataLigne
        'CD1
        DataLigne = "CD1"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
        Ligne = 25: TabDataFilm(Ligne) = DataLigne
        'CD2
        DataLigne = "CD2"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
        Ligne = 26: TabDataFilm(Ligne) = DataLigne
        'CD3
        DataLigne = "CD3"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
        Ligne = 27: TabDataFilm(Ligne) = DataLigne
        'CD4
        DataLigne = "CD4"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
        Ligne = 28: TabDataFilm(Ligne) = DataLigne
        'CD5
        DataLigne = "CD5"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
        Ligne = 29: TabDataFilm(Ligne) = DataLigne
        'CD6
        DataLigne = "CD6"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
        Ligne = 30: TabDataFilm(Ligne) = DataLigne
        'NOTE
        DataLigne = "NOTE"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & Cells(ListLigneSelected, Ligne).Value
        Ligne = 31: TabDataFilm(Ligne) = DataLigne
        'vide
        DataLigne = "vide29"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 32: TabDataFilm(Ligne) = DataLigne
        'vide
        DataLigne = "vide30"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 33: TabDataFilm(Ligne) = DataLigne
        '-----
        LinkNum = objDoc.Links.Length - 1
        If LinkNum > 0 Then
            For n = 0 To LinkNum
                If InStr(LCase(objDoc.Links(n)), "/affiche") > 0 Then
                    'lien affiche 1
                    LienAffiche = Replace(objDoc.Links(n), "http://", "")
                    Exit For
                End If
            Next n
            For n2 = 0 To LinkNum
                If InStr(LCase(objDoc.Links(n2)), "/photos/") > 0 Then
                    'lien page film
                    LienPageFilm = Replace(Split(objDoc.Links(n2), "/photos/")(0), "http://", "")
                    Exit For
                ElseIf InStr(LCase(objDoc.Links(n2)), "#distribution-complete") > 0 Then
                    'lien page film
                    LienPageFilm = Replace(Split(objDoc.Links(n2), "#distribution-complete")(0), "http://", "")
                    Exit For
                End If
            Next n2
            For n3 = 0 To LinkNum
                If InStr(LCase(objDoc.Links(n3)), "/affiches") > 0 Then
                    'lien page affiches
                    LienPageAffiches = Replace(objDoc.Links(n3), "http://", "")
                    'nombre affiches
                    NombreAffiches = Split(Split(objDoc.Links(n3).innerText, "(")(1), ")")(0)
                    Exit For
                End If
            Next n3
        End If
        'nombre affiches
        DataLigne = "Nombre Affiches"
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & NombreAffiches
        DataLigne = DataLigne & "|" & Trim(NombreAffiches)
        Ligne = 97: TabDataFilm(Ligne) = DataLigne
        'lien page film
        DataLigne = "Lien Page Film"
        DataLigne = DataLigne & "|" & LienPageFilm
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 98: TabDataFilm(Ligne) = DataLigne
        'lien page affiches
        DataLigne = "Lien Page Affiches"
        DataLigne = DataLigne & "|" & LienPageAffiches
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 99: TabDataFilm(Ligne) = DataLigne
        'lien affiche
        DataLigne = "Lien Affiche"
        DataLigne = DataLigne & "|" & LienAffiche
        DataLigne = DataLigne & "|" & ""
        DataLigne = DataLigne & "|" & ""
        Ligne = 100: TabDataFilm(Ligne) = DataLigne
        '-----
        Ligne = 199
        For n = 1 To LigneFin
            'detecte ligne de data
            If InStr(LCase(TabDataHTML(n)), "réalisation") > 0 Then
                If InStr(LCase(TabDataHTML(n)), "#distribution-complete") > 0 Then
                'distribution complete
                    'réalisation
                    'interprétation
                    'ecriture
                    'production
                    'montage
                    'photographie
                    'musique
                    'costumes
                    'décors
                    'casting
                    'maquillage
                    'direction artistique
                    'chef décoration
                    'assistant réalisation
                    'son
                    'effets spéciaux
                    'direction de production
                    Data = Split(LCase(TabDataHTML(n)), "id=distribution-complete")(1)
                    DataMETIER = Split(LCase(Split(LCase(Data), "<b>")(1)), "</b>")(0)
                    DataTab = Split(LCase(Data), "com/")
                    '-----
                    For n2 = 1 To UBound(DataTab)
                        If InStr(DataTab(n2), "-nm") > 0 Then
                            Data = Split(DataTab(n2), Chr(34))(0)
                            DataURL = "www.cinemotions.com/" & Data
                            DataNAME = Split(LCase(Data), "-nm")(0)
                            '-----
                            DataLigne = DataMETIER
                            DataLigne = DataLigne & "|" & DataURL
                            DataLigne = DataLigne & "|" & DataNAME
                            DataLigne = DataLigne & "|" & Trim(FormatActeur(DataNAME))
                            Ligne = Ligne + 1: TabDataFilm(Ligne) = DataLigne
                            '-----
                            'test catégorie métier
                            If InStr(LCase(DataTab(n2)), "<b>") > 0 Then
                                DataMETIER = Split(LCase(Split(LCase(DataTab(n2)), "<b>")(1)), "</b>")(0)
                            End If
                        End If
                    Next n2
                    Exit For
                Else
                'distribution simple
                    '----- réalisation , realisateur
                    If InStr(LCase(Range("d" & n).Value), "director") > 0 Then
                        Data = Split(LCase(Split(LCase(TabDataHTML(n)), "com/")(1)), Chr(34))(0)
                        DataURL = "www.cinemotions.com/" & Data
                        DataNAME = Split(LCase(Data), "-nm")(0)
                        '-----
                        DataLigne = "réalisation"
                        DataLigne = DataLigne & "|" & DataURL
                        DataLigne = DataLigne & "|" & DataNAME
                        DataLigne = DataLigne & "|" & Trim(FormatActeur(DataNAME))
                        Ligne = Ligne + 1: TabDataFilm(Ligne) = DataLigne
                    End If
                    '----- comédiens , acteur
                    If InStr(LCase(Range("d" & n).Value), "comédiens") > 0 Then
                        If InStr(LCase(TabDataHTML(n)), "actor") > 0 Then
                            Data = Split(LCase(TabDataHTML(n)), "comédiens")(1)
                            DataTab = Split(LCase(Data), "com/")
                            '-----
                            For n2 = 1 To UBound(DataTab)
                                Data = Split(DataTab(n2), Chr(34))(0)
                                DataURL = "www.cinemotions.com/" & Data
                                DataNAME = Split(LCase(Data), "-nm")(0)
                                '-----
                                DataLigne = "interprétation"
                                DataLigne = DataLigne & "|" & DataURL
                                DataLigne = DataLigne & "|" & DataNAME
                                DataLigne = DataLigne & "|" & Trim(FormatActeur(DataNAME))
                                Ligne = Ligne + 1: TabDataFilm(Ligne) = DataLigne
                            Next n2
                            Exit For
                        End If
                    End If 'fin de distribution simple
                End If
            End If
        Next n
    End Sub
    Waouh...
    grosse explication en perspective

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

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

    les données standards

    Pièce jointe 360393

    les adresses (URL) des affiches

    Pièce jointe 360395

    les adresses (URL) des pages/fiches des personnes

    Pièce jointe 360396

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

    Pièce jointe 360401

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

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

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

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

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

    encore une fois je précise que tout cela doit être pris comme un exemple d'utilisation...pour déclencher une idée...
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  15. #15
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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 !!!

    contrôler si la page est chargée complétement
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
     
    '-----
        'READYSTATE_UNINITIALIZED = 0
        'READYSTATE_LOADING = 1
        'READYSTATE_LOADED = 2
        'READYSTATE_INTERACTIVE = 3
        'READYSTATE_COMPLETE = 4
        'On boucle tant que la page n'est pas totalement chargée
        'pTimeOut est un time out en secondes (WaitIE vaut True si Timeout)
        Dim lTimer As Double
        lTimer = Timer
        pTimeOut = 2
        Do
            DoEvents
            If objWB.readyState = READYSTATE_COMPLETE And Not objWB.Busy Then Exit Do
            If pTimeOut > 0 And Timer - lTimer > pTimeOut Then Exit Do
        Loop
        '-----
    la boucle Do..Loop n'a pas de fin , pour en sortir il faut soit :
    le chargement de la page : If objWB.readyState = READYSTATE_COMPLETE And Not objWB.Busy Then Exit Do
    l'expiration du délais fixé à 2 secondes : If pTimeOut > 0 And Timer - lTimer > pTimeOut Then Exit Do

    maintenant que la page est chargée , on désigne un object comme étant "l’intérieur" de cette page
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
        '-----
        ' Page chargée, on continue
        Set objDoc = objWB.document
        '-----
    objDoc est notre nouveau terrain de jeu
    tout dépend maintenant de la façon dont le code à été écrit ,
    dans les règles ? , quelles règles ? , quelle version ?,...

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

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

    tout cela pour mettre les lignes de code HTML dans le tableau TabDataHTML()
    qui a été redimensionné pour 2000 lignes : ReDim TabDataHTML(2000) ce qui a tout effacé dans le tableau
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
     
        '-----
        Ligne = 1
        Set DataH = objDoc.getElementsByTagName("head")
        For n = 1 To DataH(0).all.Length - 1
            TabDataHTML(Ligne) = DataH(0).all(n).outerHTML
            Ligne = Ligne + 1
        Next n
        Set DataTab = objDoc.getElementsByTagName("table")
        For n = 1 To DataTab.Length - 1
            Set DataTD = DataTab(n).getElementsByTagName("td")
            For n2 = 1 To DataTD.Length - 1
                TabDataHTML(Ligne) = DataTD(n2).innerHTML
                Ligne = Ligne + 1
            Next n2
        Next n
        '-----
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    LigneFin = UBound(TabDataHTML)
    non ce n'est pas un bug : LigneFin = UBound(TabDataHTML) c'est juste une ligne maladroite
    (j'ai vérifié) LigneFin = 2000 , on aurait pu croire que c'était les lignes "pleines" du tableau ... et non

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

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

    Pièce jointe 360416

    et voila le code !!! ne pas perdre de vue , la propriété intellectuelle , les droits , et les machins , et les choses...!!!
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  16. #16
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut Le Titre , Alias , Année , le Genre

    Bonjour,

    notre cible

    Pièce jointe 360426

    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 360430

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

    Pièce jointe 360431

    notre nouvelle cible (qui fonctionne)

    Pièce jointe 360433

    et le résultat correct

    Pièce jointe 360435

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

    voyons le code de cette page

    Pièce jointe 360436

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

    Pièce jointe 360441

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

    Pièce jointe 360445
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  17. #17
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut Problème , action , réaction , correction

    Bonjour,

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

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

    je vais quand même vous expliquez comment fonctionnait ce code , et ensuite , je le modifierais...
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
        '----- description
        DataElement = objDoc.getElementsByName("description")
        TabElement = Split(DataElement.Content, "-")
        '-----
    la base du code , était de chercher dans objDoc
    un élément ayant pour nom "description" : DataElement = objDoc.getElementsByName("description")

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

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

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

    Pièce jointe 360451

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

    Pièce jointe 360456

    maintenant avec la souris , je me positionne sur le titre

    Pièce jointe 360461

    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 ?

    je décide de garder l'ancien code , qui fonctionne bien avec de nombreuses pages ,
    et j'ajoute un test (qui doit être solide) sur l'année
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
     
    '----- description
        DataElement = objDoc.getElementsByName("description")
        TabElement = Split(DataElement.Content, "-")
        '----- test de version
        If Len(Trim(TabElement(1))) = 4 And Val(Trim(TabElement(1))) > 1800 Then
            If InStr(TabElement(0), "(") > 0 Then
                Titre = Trim(FormatTitre(Split(TabElement(0), "(")(0)))
                Alias = Trim(FormatTitre(Replace(Split(TabElement(0), "(")(1), ")", "")))
            Else
                Titre = Trim(FormatTitre(TabElement(0)))
                Alias = ""
            End If
            'titre
            DataLigne = "Titre"
            DataLigne = DataLigne & "|" & ""
            DataLigne = DataLigne & "|" & Trim(TabElement(0))
            DataLigne = DataLigne & "|" & Titre
            Ligne = 1: TabDataFilm(Ligne) = DataLigne
            'alias
            DataLigne = "Alias"
            DataLigne = DataLigne & "|" & ""
            DataLigne = DataLigne & "|" & Trim(TabElement(0))
            DataLigne = DataLigne & "|" & Alias
            Ligne = 2: TabDataFilm(Ligne) = DataLigne
            'année
            DataLigne = "Année"
            DataLigne = DataLigne & "|" & ""
            DataLigne = DataLigne & "|" & Trim(TabElement(1))
            DataLigne = DataLigne & "|" & Trim(TabElement(1))
            Ligne = 3: TabDataFilm(Ligne) = DataLigne
            'genre
            If InStr(LCase(TabElement(2)), "science") > 0 Then
                DataGenre = "Science-Fiction"
            Else
                DataGenre = Trim(TabElement(2))
            End If
            DataLigne = "Genre"
            DataLigne = DataLigne & "|" & ""
            DataLigne = DataLigne & "|" & Trim(TabElement(2))
            DataLigne = DataLigne & "|" & DataGenre
            Ligne = 4: TabDataFilm(Ligne) = DataLigne
        Else
            MsgBox "une nouvelle version d'extraction est requise"
            'ICI...le code de la nouvelle version...2018-03-12
        End If
        '-----
    je teste avec la page du film (2001) qui fonctionne , l'extraction se fait correctement ,
    je teste avec la page du film (2017) , le test fonctionne et aiguille le code vers la prochaine version

    Pièce jointe 360466

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

    Pièce jointe 360471

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

    alors j'ai testé ce code dans la partie de la nouvelle version
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
        Else
            'MsgBox "une nouvelle version d'extraction est requise"
            'ICI...le code de la nouvelle version...2018-03-12
            MsgBox objWB.document.URL
        End If
    Résultat

    Pièce jointe 360476

    une petite modif
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
     
        Else
            'MsgBox "une nouvelle version d'extraction est requise"
            'ICI...le code de la nouvelle version...2018-03-12
            DataLien = "href=" & Chr(34) & "/" & Split(objWB.document.URL, "com/")(1) & Chr(34)
            MsgBox objWB.document.URL & vbCrLf & DataLien
        End If
    Résultat

    Pièce jointe 360481

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

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

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

    pour contrôler , je modifie le code
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
     
       Else
            'MsgBox "une nouvelle version d'extraction est requise"
            'ICI...le code de la nouvelle version...2018-03-12
            DataLien = "href=" & Chr(34) & "/" & Split(objWB.document.URL, "com/")(1) & Chr(34)
            'MsgBox objWB.document.URL & vbCrLf & DataLien
            Msg = objWB.document.URL & vbCrLf & DataLien
            For n = 1 To LigneFin
                'detecte ligne de data
                If InStr(TabDataHTML(n), DataLien) > 0 Then
                    Msg = Msg & vbCrLf & vbCrLf & "Correspondance trouvée ligne..." & n
                    Msg = Msg & vbCrLf & vbCrLf & TabDataHTML(n)
                    Exit For
                End If
            Next n
            MsgBox Msg
        End If
    Résultat

    Pièce jointe 360485

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

    nous , on veux le morceau d’après ... (1)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    Data1 = Split(LCase(TabDataHTML(n)), "itemprop=" & Chr(34) & "name" & Chr(34) & ">")(1)
    notez : l'usage de LCase() qui met tout en minuscule
    donc , avec LCase(TabDataHTML(n)) , la ligne "n" du tableau TabDataHTML() qui contient le code HTML du document objDoc est mise en minuscule

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

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

    on va le couper en morceaux à l’endroit où se trouve "<" ... il y aura au moins 4 morceaux de 0 à 3
    (0) La Planète des Singes - Suprématie --> c'est celui qui nous intéresse
    (1) /span
    (2) /a
    (3) /h1> ...
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    Data2 = Split(Data1, "<")(0)
    Data2 contient le morceau (0) du morceau Data1 : "La Planète des Singes - Suprématie"

    le code modifié
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
     
       Else
            'MsgBox "une nouvelle version d'extraction est requise"
            'ICI...le code de la nouvelle version...2018-03-12
            '-----
            Msg = objWB.document.URL
     
            DataLien = "href=" & Chr(34) & "/" & Split(objWB.document.URL, "com/")(1) & Chr(34)
     
            Msg = Msg & vbCrLf & DataLien
     
            For n = 1 To LigneFin
                'detecte ligne de data
                If InStr(LCase(TabDataHTML(n)), LCase(DataLien)) > 0 Then
                    'Correspondance trouvée ligne... n
                    Msg = Msg & vbCrLf & vbCrLf & "Correspondance trouvée ligne..." & n
                    Ligne = n
                    Exit For
                End If
            Next n 
     
            For n = Ligne To LigneFin
                'detecte "itemprop"
                If InStr(LCase(TabDataHTML(n)), "itemprop=" & Chr(34) & "name" & Chr(34) & ">") > 0 Then
                    'Correspondance trouvée ligne... n
                    Msg = Msg & vbCrLf & vbCrLf & "Titre trouvé ligne..." & n
                    Data = Split(Split(LCase(TabDataHTML(n)), "itemprop=" & Chr(34) & "name" & Chr(34) & ">")(1), "<")(0)
                    Exit For
                End If
            Next n
     
            Msg = Msg & vbCrLf & vbCrLf & "Titre du Film ... " & Data
            MsgBox Msg
        End If
    Résultat

    Pièce jointe 360493

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

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

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

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

    le code "Alias" qui vient à la suite...
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
     
            '----- 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

    Pièce jointe 360495

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

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

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

    et la Date ?

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

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

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

    voyons le code
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
     
            '----- Année
            Data = ""
            For n = Ligne To Ligne + 10
                TabElement = Split(TabDataHTML(n), ">")
                'detecte ligne de data
                For n2 = 0 To UBound(TabElement)
                    Data = Left(Trim(TabElement(n2)), 4)
                    If Val(Data) > 1800 Then
                        'Correspondance trouvée ligne... n
                        Ligne = n
                        Exit For
                    End If
                Next n2
                If Data <> "" Then Exit For
            Next n
            MsgBox Data
    Résultat

    Pièce jointe 360496

    pour le "Genre" du Film ,
    <div style="height:3px;"></div>
    <a href="http://www.cinemotions.com/genre/fantastique" class="link_menu_film"><b><span itemprop="genre">Fantastique</span></b></a>
    /<a href="http://www.cinemotions.com/genre/action" class="link_menu_film"><b><span itemprop="genre">Action</span></b></a>
    /<a href="http://www.cinemotions.com/genre/aventures" class="link_menu_film"><b><span itemprop="genre">Aventures</span></b></a>
    </div>
    je vais m’orienter vers les "Lien" ,
    il est possible de récupérer l'ensemble des liens du code HTML de l'object Document objDoc avec : objDoc.Links
    pour connaitre le nombre de liens : LinkNum = objDoc.Links.Length - 1

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

    voyons le code
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
     
            '----- Genre
            Data = ""
            LinkNum = objDoc.Links.Length - 1
            If LinkNum > 0 Then
                For n = 0 To LinkNum
                    If InStr(LCase(objDoc.Links(n)), "/genre/") > 0 Then
                        Data = Data & Split(Split(LCase(objDoc.Links(n)), "/genre/")(1), Chr(34))(0) & ";"
                    End If
                Next n
                Data = Left(Data, Len(Data) - 1)
                MsgBox Data
            End If
    Résultat

    Pièce jointe 360501
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  18. #18
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut Extraction , le Retour

    Bonjour,

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

    Pièce jointe 360503

    comme on peut le voir , la modif fonctionne correctement
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  19. #19
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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 )

    étudions le terrain avec F12

    Pièce jointe 360506

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

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

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

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

    vola le code (présenté plus haut)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     
        'résumé / synopsis
        Set DataSpan = objDoc.getElementsByTagName("span")
        For n = 1 To 200
            If InStr(LCase(DataSpan(n).outerHTML), "description") > 0 Then
                DataResume = Trim(Replace(Replace(DataSpan(n).outerText, vbCrLf, ""), "|", ":"))
                Exit For
            End If
        Next n
    et voila le nouveau code modifié (en Direct )
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
     
        'résumé / synopsis
        NumSpan = objDoc.getElementsByTagName("span").Length
        Set DataSpan = objDoc.getElementsByTagName("span")
        For n = 1 To NumSpan
            If InStr(LCase(DataSpan(n).outerHTML), "description") > 0 Then
                DataResume = Trim(Replace(Replace(DataSpan(n).outerText, vbCrLf, ""), "|", ":"))
                Exit For
            End If
        Next n
    la modif , c'est NumSpan qui est le nombre de ligne de la "Collection"

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

    la ligne de code formate le code ,
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
                DataResume = Trim(Replace(Replace(DataSpan(n).outerText, vbCrLf, ""), "|", ":"))
    elle supprime l'action de la "Balise" "</br>" qui est égale à "vbCrlf" (retour à la ligne) ,
    le remplacement de "|" par ":" est pour certain cas...

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

    voila pour la partie EXTRACTION DATA WEB

    @+JP
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  20. #20
    Membre expérimenté Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    1 038
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 1 038
    Points : 1 333
    Points
    1 333

    Par défaut 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"
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

Discussions similaires

  1. Gestion d'une page web HTML/PHP
    Par amine_en_france dans le forum Fichiers
    Réponses: 9
    Dernier message: 06/03/2007, 12h37
  2. Réponses: 52
    Dernier message: 23/05/2006, 12h08
  3. [debutant]msde + web database admin !
    Par ChristopheOce dans le forum MS SQL-Server
    Réponses: 6
    Dernier message: 10/02/2006, 08h54

Partager

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