Discussion :

[mjpmjp]

Bonjour,

comme pour la partie "Extraire" ,
dans la partie "Affiche" , çà , c'est ce que l'Utilisateur voit...



çà c'est la structure "générale" de la frame "Affiches"



et çà c'est ce que vous n'avez pas vu

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" : FrmAffiche --> qui ce déplace dans la frame principale --> si activée : left=0 ... si non left = 1200
le gris clair : la frame "data" : FrmAfficheData --> qui est à l’intérieur de FrmAffiche
le bordeau : la frame "scroll" : FrmAfficheW --> qui est à l’intérieur de FrmAfficheData et qui contient FrmAfficheWCtrl
le blanc : la frame "contrôle" : FrmAfficheWCtrl --> qui est à l'intérieur de FrmAfficheW et qui contient les contrôles

la frame bordeau FrmAfficheW , c'est la "bande" d' Affiches du Web (du haut) , et donc ... W
pour la "bande" du bas , les Affiches du PC , c'est le même principe , et donc on remplace le W par D ...
D comme Dossier

dans une bande , il y a 100 ensemble / module



chaqu'un regroupe 4 contrôles (numéroté de 0 à 99)

ImgW0 : contrôle Image --> reçoit l' Affiche Web n°0
TxbNumW0 : contrôle TextBox --> le numéro de 0 à 99
TxbSizeW0 : contrôle TextBox --> la Taille de l' Image (Affiche)
ChkW0 : contrôle CheckBox --> pour la sélection de l' Affiche

cet ensemble est masqué par le jeu de scroll ,



il sert au fonctionnement des déplacement / sélection des affiches
ImgW100 : contrôle Image --> reçoit temporairement une Affiche
LblCouperW : contrôle Label --> est positionné sur une des 100 Affiches et marque le "Départ"
LblCollerW : contrôle Label --> est positionné sur une des 100 Affiches et marque l' "Arrivée"

on y reviendra à l'étude du code

et on arrive à la grande Question ... comment sélectionner une Affiche (contrôle Image) parmi 100 possibilités (200 avec 2 bandes) ?
la Réponse , avec 1 Label ...



un nouveau code couleur ,
le marron : le Label "sélection" : LblWGlass --> permet de sélectionner 1 contrôle parmi 100 autres

voila une autre vue , avec la hauteur du label LblWGlass modifiée ,



l'étape suivante c'est toutes les propriétés , à étudier .. ou à passer ...

[mjpmjp]

Bonjour,

j'allais oublier les Propriétés
on a déjà vu les noms , le reste peut être utile pour la compréhension ...

la série 1 : les Frames en général et autres contrôles



la série 2 : les Frames et le Label d'une bande



la série 3 : ensemble / module Image



la série 4 : boutons ... regardez Caption et Font




voila pour la structure , passons à l'étude du code

[mjpmjp]

Bonjour,

quand l'ordre a été donner de préparer le form pour le prochain film , il a bien fallut s'occuper de la partie Affiches ...
Le Grand Ménage : La Suite
on commence par effacer les "Bandes"

Code :

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

1
2
 
Call AfficheFormEfface(objFormDataWebFilm)

Ce code s'occupe des 2 Bandes : W --> Web ... et ... D --> Dossier

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Public Sub AfficheFormEfface(objForm As Object)
    For n = 0 To 99
        objForm.Controls("ImgW" & n).Picture = Nothing
        objForm.Controls("ImgD" & n).Picture = Nothing
        objForm.Controls("TxbSizeW" & n).Value = ""
        objForm.Controls("TxbSizeD" & n).Value = ""
        objForm.Controls("ChkW" & n).Value = False
        objForm.Controls("ChkD" & n).Value = False
    Next n
End Sub

celui ci s'occupe uniquement de la Bande W

Code :

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

1
2
3
4
5
6
7
8
9
10
 
Public Sub AfficheFormEffaceWeb(objForm As Object)
    FormDataWebFilm_IsChangeInProgress = True
    For n = 0 To 99
        objForm.Controls("ImgW" & n).Picture = Nothing
        objForm.Controls("TxbSizeW" & n).Value = ""
        objForm.Controls("ChkW" & n).Value = False
    Next n
    FormDataWebFilm_IsChangeInProgress = False
End Sub

celui ci s'occupe uniquement de la Bande D

Code :

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

1
2
3
4
5
6
7
8
9
10
 
Public Sub AfficheFormEffaceDossier(objForm As Object)
    FormDataWebFilm_IsChangeInProgress = True
    For n = 0 To 99
        objForm.Controls("ImgD" & n).Picture = Nothing
        objForm.Controls("TxbSizeD" & n).Value = ""
        objForm.Controls("ChkD" & n).Value = False
    Next n
    FormDataWebFilm_IsChangeInProgress = False
End Sub

Charger les Data contenus dans le PC : La Suite
quand c'est tout propre on charge les Affiches du Nouveau Film qui sont dans un Dossier du PC

Code :

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

1
2
 
Call DataFilmAfficheDossier(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
 
Public Sub DataFilmAfficheDossier(ByVal objForm As Object)
    Dim FSO As Variant
    Dim PathSource As String
    Dim Titre As String
    Dim ImageName As String
    Dim ImgNumList As Integer
    '-------------------
    On Error GoTo GestionErreur
    '-------------------
    'pour bloquer les object interactif...option, check...
    FormDataWebFilm_IsChangeInProgress = True
    '-------------------
    'charge les affiches qui correspondent au Titre de ObjForm.TxbTitreList.Text
    'à partir de Dossier : PathSource = DriveValide & PathAffiche
    PathSource = DriveValide & PathAffiche
    Titre = objForm.Caption
    NombreAffiche = 0
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For ImgNum = 0 To 99
        If ImgNum > 9 Then
            ImageName = Titre & " A-" & ImgNum & ".jpg"
        Else
            ImageName = Titre & " A-0" & ImgNum & ".jpg"
        End If
        'si image existe
        If FSO.FileExists(PathSource & ImageName) Then
            'charge image dans la Bande
            objForm.Controls("ImgD" & ImgNum).Picture = LoadPicture(PathSource & ImageName)
            objForm.Controls("TxbSizeD" & ImgNum).Value = Int(objForm.Controls("ImgD" & ImgNum).Picture.Width / 26.45) & " x " & Int(objForm.Controls("ImgD" & ImgNum).Picture.Height / 26.45)
            'objForm.Controls("ChkD" & ImgNum).Value = True
            NombreAffiche = NombreAffiche + 1
        End If
    Next ImgNum
    'ObjForm.TxbAfficheTotalList.Text = NombreAffiche
    objForm.Repaint
    Set FSO = Nothing
    FormDataWebFilm_IsChangeInProgress = False
    Exit Sub
GestionErreur:
    MsgBox Err
    Resume Next
End Sub

tout est expliqué dans le code !! ...

je vous montre la structure du nom de l'affiche (pour comprendre le code )
c'est : Le Titre Du Film + " " + (Année) + " " + A-00 ... A --> Affiche ... J --> Jaquette
ce qui donne : La Planete Des Singes - C3 - Suprematie (2017) A-00 ... A-01 ...

[mjpmjp]

Bonjour,

pour l' Extraction , il faut revenir au code du bouton Extraire ..(action)

Code :

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

1
2
3
4
5
6
 
        '----- efface affiche
        Call AfficheFormEffaceWeb(objFormDataWebFilm)
        Call DataFilmAfficheWeb(objFormDataWebFilm)
        Call AffichesPageWeb(objFormDataWebFilm)
        '-----

on a vu (au dessus) que Call AfficheFormEffaceWeb(objFormDataWebFilm) efface uniquement la "Bande" Web ...

Call DataFilmAfficheWeb(objFormDataWebFilm) , extrait l' Affiche de la Page / Fiche du film ,
cette Affiche est l' Affiche A-00 et va donc être chargée dans le contrôle ImgW0 --> Contrôle Image Web 0

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
 
Public Sub DataFilmAfficheWeb(objForm As Object)
    FormDataWebFilm_IsChangeInProgress = True
    On Error Resume Next
    PathAfficheTMP = DriveValide & PathDataWebTMP
    'enregistre l'affiche 1 comme image "ImageTMP_0.jpg"
    ImageName = PathAfficheTMP & "ImageTMP_0" & ".jpg"
    LienVersAfficheFilm = "http://" & Split(TabDataFilm(100), "|")(1)
    Call SaveDownloadFile(LienVersAfficheFilm, ImageName)
    objForm.Controls("ImgW0").Picture = LoadPicture(ImageName)
    objForm.TxbSizeW0.Value = Int(objForm.ImgW0.Picture.Width / 26.45) & " x " & Int(objForm.ImgW0.Picture.Height / 26.45)
    objForm.ChkW0.Value = True
    TabDataFilm(100) = TabDataFilm(100) & objForm.Controls("TxbSizeW0").Value
    FormDataWebFilm_IsChangeInProgress = False
End Sub

au tout début , on indique que le travail (dans le form FormDataWebFilm) a commencé : FormDataWebFilm_IsChangeInProgress = True
on détermine la "Destination Temporaire" de l' Image : PathAfficheTMP = DriveValide & PathDataWebTMP
on construit le "Full Name" (Temporaire également) de l' Image : ImageName = PathAfficheTMP & "ImageTMP_0" & ".jpg"
ici , Full = Complet , c'est à dire que le nom complet , c'est "le Chemin et le Nom" ... Chemin = PathAfficheTMP

maintenant ,
on ne va pas faire comme dans la partie Extraire , on ne va pas chercher dans le code HTML ... on a déjà fait le boulot !!
quand on a extrait les Data avec DataFilmWebExtraire() pour la frame FrmData ,
on a également extrait les infos disponibles au sujet des Affiches

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

à ce moment , le Fichier.txt , qui aura le même nom que le Titre du Film , n'est pas encore créé ,

le Tableau TabDataFilm() contient toutes les lignes du Fichier.txt
et on sait que la première ligne du "groupe" URL Affiche , commence à la ligne 100

Détail des Lignes
Nombre Affiches : ligne 97
Lien Page Film : ligne 98
Lien Page Affiches : ligne 99
Lien Affiche : ligne 100

on peut donc construire le Lien Web vers l' Affiche 0 : LienVersAfficheFilm = "http://" & Split(TabDataFilm(100), "|")(1)
souvenez vous , le (1) veut dire après le "|"

on a le Lien et le Full Name ,
on va donc Extraire l' Affiche et la Sauvegarder avec un Nom Temporaire et dans un Dossier Temporaire avec :
Call SaveDownloadFile(LienVersAfficheFilm, ImageName)

Code :

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

1
2
3
4
5
6
7
8
9
 
Public Function SaveDownloadFile(ByVal URL As String, ByVal LocalFilename As String) As Boolean
    On Error Resume Next
    SaveDownloadFile = False
    If URLDownloadToFile(0, URL, LocalFilename, 0, 0) = 0 Then
        SaveDownloadFile = True
    End If
    'Result = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
End Function

quoi dire sur ce code ?
j'ai choisis de sélectionner (par défaut) les Affiches Web par rapport au Affiche PC avec :
objForm.ChkW0.Value = True
je rappelle que les Affiches sélectionnées seront enregistrées , les autres effacées !!

pour charger l' Image dans le contrôle Image : objForm.Controls("ImgW0").Picture = LoadPicture(ImageName) --> ImageName est le FullName

et la Formule pour calculer la Taille de l' Image :
objForm.TxbSizeW0.Value = Int(objForm.ImgW0.Picture.Width / 26.45) & " x " & Int(objForm.ImgW0.Picture.Height / 26.45)

et on indique qu'on a fini de travailler : FormDataWebFilm_IsChangeInProgress = False

[mjpmjp]

Bonjour,

les autres Affiches du Film sont dans une autre page Web



avec le dernier appel du bouton Extraire..(action) : Call AffichesPageWeb(objFormDataWebFilm) ,
on va , dans le navigateur , charger la page des Affiches ,
on va extraire les affiches , les sauvegarder ,
on va les charger dans la "Bande" Web , après l' Affiche A-00 ,
on va noter dans le Tableau TabDataFilm() les URL des Affiches

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
 
Public Sub AffichesPageWeb(objForm As Object)
    FormDataWebFilm_IsChangeInProgress = True
    On Error Resume Next
    'charge la page affiches et enregistre les affiches
    PathAfficheTMP = DriveValide & PathDataWebTMP
    'nombre affiches
    NombreAffiche = Split(TabDataFilm(97), "|")(2)
    If NombreAffiche < 2 Then Exit Sub
    'charge la page affiches
    URL = Split(TabDataFilm(99), "|")(1)
    objWB.navigate ("http://" & URL)
    '-----
    '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 = 3
    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
    '-----
    'Extraire Affiche
    '-----
    ImgNum = 0
    Ligne = 100
    'cherhe les Tag "img" (pour image)
    Set DataImg = objDoc.getElementsByTagName("img")
    For Each oImg In DataImg
        'si le Tag contient un lien "src" "affiche."
        If InStr(LCase(oImg.src), "affiche.") > 0 Then
            ImgNum = ImgNum + 1
            URL = "http://" & "www.cinemotions.com/affiche." & Split(oImg.src, "affiche.")(1)
            ImageName = PathAfficheTMP & "ImageTMP_" & ImgNum & Right(URL, 4) '& ".jpg"
            'enregistre l'affiche comme image "ImageTMP_n.jpg"(avec n = ImgNum = 1..99)
            '-----
            Call SaveDownloadFile(URL, ImageName)
            '-----
            objForm.Controls("ImgW" & ImgNum).Picture = LoadPicture(ImageName)
            objForm.Controls("TxbSizeW" & ImgNum).Value = Int(objForm.Controls("ImgW" & ImgNum).Picture.Width / 26.45) & " x " & Int(objForm.Controls("ImgW" & ImgNum).Picture.Height / 26.45)
            objForm.Controls("ChkW" & ImgNum).Value = True
            TabDataFilm(Ligne + ImgNum) = "Lien Affiche|" & Split(URL, "//")(1) & "||" & objForm.Controls("TxbSizeW" & ImgNum).Value
        End If
    Next oImg
    FormDataWebFilm_IsChangeInProgress = False
End Sub

tout ce qui est dans ce code , on l'a déjà étudié !!

Résultat

[mjpmjp]

Bonjour,

c'est ICI , qu' on va voir comment sélectionner une Affiche parmi 100 autres avec 1 Label ,

pourquoi sélectionner une Affiche ?

pour voir l'Affiche en plus grand ,
après avoir déactivé le bouton CmdCouperColler , et activé le bouton Zoom ,

je clique /sélectionne l' Affiche n°4 qui est chargée dans le contrôle ImageZoom ...



le Bouton CmdZoom ,

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
 
Private Sub CmdZoom_Click()
    If Me.CmdZoom.Caption = 1 Then
        Me.FrmAfficheW.Width = 230
        Me.FrmAfficheD.Width = 230
        Me.ScrollBar1.Width = 230
        Me.FrmAfficheZoom.Visible = True
        Me.CmdZoom.Caption = 2
        'couleur "active"
        Me.CmdZoom.BackColor = &H80000002
        Me.CmdZoom.ForeColor = &H8000000F
    Else
        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
    End If
End Sub

le Bouton CmdCouperColler ,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub CmdCouperColler_Click()
    If Me.CmdCouperColler.BackColor = &H8000000F Then
        'couleur "active"
        Me.CmdCouperColler.BackColor = &H80000002
        Me.CmdCouperColler.ForeColor = &H8000000F
    Else
        'couleur "normale"
        Me.CmdCouperColler.BackColor = &H8000000F
        Me.CmdCouperColler.ForeColor = &H80000002
    End If
End Sub

la Sélection d'une Affiche (Bande W) ,

Code :

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

1
2
3
4
5
 
Private Sub LblWGlass_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Me.CmdZoom.Caption = 2 Then Me.ImageZoom.Picture = Me.Controls("ImgW" & Int(X / 100)).Picture
    If Me.CmdCouperColler.BackColor = &H80000002 Then Call ImgInverse(objFormDataWebFilm, "W", Int(X / 100))
End Sub

pour inverser 2 Affiches ,



le résultat de l'inversion ,



le code pour Inverser , fonctionne Horizontalement et Verticalement ,
dans notre exemple , on Inverse Horizontalement puisque on reste dans la même Bande W ,
on aurait pu Inverser Verticalement en sélectionnant une Affiche dans la Bande D te une autre dans la Bande W

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
 
Private Sub ImgInverse(objForm As Object, WD As String, ImgNum As Integer)
    Select Case WD
        Case "W"
            If ImgCouper = "Img" & WD & ImgNum Then
                'change la selection
                ImgCouper = ""
                LblCouperW.Visible = False
                Couper_IsSelect = False
                Exit Sub
            End If
            If ImgColler = "Img" & WD & ImgNum Then
                'change la selection
                ImgColler = ""
                LblCollerW.Visible = False
                Coller_IsSelect = False
                Exit Sub
            End If
            If Couper_IsSelect = True And Coller_IsSelect = False Then
                'selection de la cible
                ImgCollerWD = WD
                ImgCollerNum = ImgNum
                ImgColler = "Img" & WD & ImgNum
                LblCollerW.Left = objForm.Controls(ImgColler).Left
                LblCollerW.Top = objForm.Controls(ImgColler).Top + objForm.Controls(ImgColler).Height - objForm.LblCollerW.Height
                LblCollerW.Visible = True
                Coller_IsSelect = True
            ElseIf Couper_IsSelect = False Then
                'selection de la source
                ImgCouperWD = WD
                ImgCouperNum = ImgNum
                ImgCouper = "Img" & WD & ImgNum
                LblCouperW.Left = objForm.Controls(ImgCouper).Left
                LblCouperW.Top = objForm.Controls(ImgCouper).Top
                LblCouperW.Visible = True
                Couper_IsSelect = True
            End If
        Case "D"
            If ImgCouper = "Img" & WD & ImgNum Then
                'change la selection
                ImgCouper = ""
                LblCouperD.Visible = False
                Couper_IsSelect = False
                Exit Sub
            End If
            If ImgColler = "Img" & WD & ImgNum Then
                'change la selection
                ImgColler = ""
                LblCollerD.Visible = False
                Coller_IsSelect = False
                Exit Sub
            End If
            If Couper_IsSelect = True And Coller_IsSelect = False Then
                'selection de la cible
                ImgCollerWD = WD
                ImgCollerNum = ImgNum
                ImgColler = "Img" & WD & ImgNum
                LblCollerD.Left = objForm.Controls(ImgColler).Left
                LblCollerD.Top = objForm.Controls(ImgColler).Top + objForm.Controls(ImgColler).Height - objForm.LblCollerD.Height
                LblCollerD.Visible = True
                Coller_IsSelect = True
            ElseIf Couper_IsSelect = False Then
                'selection de la source
                ImgCouperWD = WD
                ImgCouperNum = ImgNum
                ImgCouper = "Img" & WD & ImgNum
                LblCouperD.Left = objForm.Controls(ImgCouper).Left
                LblCouperD.Top = objForm.Controls(ImgCouper).Top
                LblCouperD.Visible = True
                Couper_IsSelect = True
            End If
    End Select
End Sub

[mjpmjp]

Bonjour,

dans LblWGlass_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) ,
j'ai intégré ce bout de code pour voir la valeur de X

Code :

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

1
2
 
MsgBox "X = " & X & vbCrLf & "Affiche = " & Int(X / 100)

Résultat



à noter : pour la suite ,

Code :

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

1
2
3
4
5
6
7
8
9
 
Public Couper_IsSelect As Boolean
Public Coller_IsSelect As Boolean
Public ImgCouper As String
Public ImgColler As String
Public ImgCouperWD As String
Public ImgCollerWD As String
Public ImgCouperNum As String
Public ImgCollerNum As String

pour l'appel , Call ImgInverse(objFormDataWebFilm, "W", Int(X / 100)) on transmet tous les paramètres :
objFormDataWebFilm --> Un Double du Form
W --> la Bande W
Int(X / 100) --> le numéro de l'Affiche

dans la procédure ImgInverse(objForm As Object, WD As String, ImgNum As Integer) ,
on détermine si on est dans la Bande Web ou la Bande Dossier ,

on teste ImgCouper : If ImgCouper = "Img" & WD & ImgNum Then --> Img W 4
ici , ImgCouper = "" et Couper_IsSelect = False ,

on arrive donc au test : ElseIf Couper_IsSelect = False Then ,
et on initialise ImgCouper : ImgCouper = "Img" & WD & ImgNum --> ImgW4 ,
ImgW4 , c'est le nom d'un contrôle Image ...

on positionne le Label LblCouperW sur le contrôle ImgW4 et on le rend visible :

Code :

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

1
2
3
4
 
LblCouperW.Left = objForm.Controls(ImgCouper).Left
 LblCouperW.Top = objForm.Controls(ImgCouper).Top
 LblCouperW.Visible = True

et on indique qu'on a une Affiche "Couper" : Couper_IsSelect = True

et pour Coller ?
c'est exactement la même chose !! ,
si une Affiche est "Couper" : Couper_IsSelect = True ,
alors l' autre Affiche est "Coller" : Coller_IsSelect = True

l' Action "Inverser" s’effectue avec le Bouton CmdInverser ,

Code :

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

1
2
3
4
 
Private Sub CmdInverser_Click()
    Call DataFilmAfficheInverser(objFormDataWebFilm)
End Sub

[mjpmjp]

Bonjour,

le code se trouve dans le Module : JP_WB_DataFilmAfficheInverser ,

avec l'appel : Call DataFilmAfficheInverser(objFormDataWebFilm) , un Double du Form est passé en paramètre

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
 
Public Sub DataFilmAfficheInverser(objForm As Object)
    PathAfficheDossier = DriveValide & PathAffiche
    PathAfficheTMP = DriveValide & PathDataWebTMP
    AfficheTitre = ActiveSheet.Range(ListColonTitre & ActiveCell.Row).Value
    Set FSO = CreateObject("Scripting.FileSystemObject")
    '-----
    objForm.Controls("ImgW100").Picture = objForm.Controls(ImgCouper).Picture
    objForm.Controls(ImgCouper).Picture = objForm.Controls(ImgColler).Picture
    objForm.Controls(ImgColler).Picture = objForm.Controls("ImgW100").Picture
    objForm.Controls("ImgW100").Picture = Nothing
 
    objForm.Controls("TxbSize" & ImgCollerWD & ImgCollerNum).Value = objForm.Controls("TxbSize" & ImgCouperWD & ImgCouperNum).Value
    objForm.Controls("Chk" & ImgCollerWD & ImgCollerNum).Value = True
 
    If objForm.Controls(ImgCouper).Picture Is Nothing Then
        objForm.Controls("TxbSize" & ImgCouperWD & ImgCouperNum).Value = ""
        objForm.Controls("Chk" & ImgCouperWD & ImgCouperNum).Value = False
    Else
        objForm.Controls("TxbSize" & ImgCouperWD & ImgCouperNum).Value = Int(objForm.Controls("Img" & ImgCouperWD & ImgCouperNum).Picture.Width / 26.45) & " x " & Int(objForm.Controls("Img" & ImgCouperWD & ImgCouperNum).Picture.Height / 26.45)
        objForm.Controls("Chk" & ImgCouperWD & ImgCouperNum).Value = True
    End If
 
    Select Case ImgCouperWD
        Case "W"
            Select Case ImgCollerWD
                Case "W"
                    If FSO.FileExists(PathAfficheTMP & "ImageTMP_" & ImgCouperNum & ".jpg") Then
                        Set FichierTemp = FSO.GetFile(PathAfficheTMP & "ImageTMP_" & ImgCouperNum & ".jpg")
                        FichierTemp.Name = "ImageTMPCouper_" & ImgCouperNum & ".jpg"
                    End If
                    If FSO.FileExists(PathAfficheTMP & "ImageTMP_" & ImgCollerNum & ".jpg") Then
                        Set FichierTemp = FSO.GetFile(PathAfficheTMP & "ImageTMP_" & ImgCollerNum & ".jpg")
                        FichierTemp.Name = "ImageTMP_" & ImgCouperNum & ".jpg"
                    End If
                    If FSO.FileExists(PathAfficheTMP & "ImageTMPCouper_" & ImgCouperNum & ".jpg") Then
                        Set FichierTemp = FSO.GetFile(PathAfficheTMP & "ImageTMPCouper_" & ImgCouperNum & ".jpg")
                        FichierTemp.Name = "ImageTMP_" & ImgCollerNum & ".jpg"
                    End If
                Case "D"
                    If FSO.FileExists(PathAfficheTMP & "ImageTMP_" & ImgCouperNum & ".jpg") Then
                        Result = FSO.MoveFile(PathAfficheTMP & "ImageTMP_" & ImgCouperNum & ".jpg", PathAfficheDossier & "ImageTMPCouper_" & ImgCouperNum & ".jpg")
                    End If
                    If ImgCollerNum > 9 Then
                        AfficheNameColler = AfficheTitre & " A-" & ImgCollerNum & ".jpg"
                    Else
                        AfficheNameColler = AfficheTitre & " A-0" & ImgCollerNum & ".jpg"
                    End If
                    If FSO.FileExists(PathAfficheDossier & AfficheNameColler) Then
                        Result = FSO.MoveFile(PathAfficheDossier & AfficheNameColler, PathAfficheTMP & "ImageTMP_" & ImgCouperNum & ".jpg")
                    End If
                    If FSO.FileExists(PathAfficheDossier & "ImageTMPCouper_" & ImgCouperNum & ".jpg") Then
                        Set FichierTemp = FSO.GetFile(PathAfficheDossier & "ImageTMPCouper_" & ImgCouperNum & ".jpg")
                        FichierTemp.Name = AfficheNameColler
                    End If
            End Select
        Case "D"
            Select Case ImgCollerWD
                Case "W"
                    If ImgCouperNum > 9 Then
                        AfficheNameCouper = AfficheTitre & " A-" & ImgCouperNum & ".jpg"
                    Else
                        AfficheNameCouper = AfficheTitre & " A-0" & ImgCouperNum & ".jpg"
                    End If
                    If FSO.FileExists(PathAfficheDossier & AfficheNameCouper) Then
                        Result = FSO.MoveFile(PathAfficheDossier & AfficheNameCouper, PathAfficheTMP & "ImageTMPCouper_" & ImgCouperNum & ".jpg")
                    End If
                    If FSO.FileExists(PathAfficheTMP & "ImageTMP_" & ImgCollerNum & ".jpg") Then
                        Result = FSO.MoveFile(PathAfficheTMP & "ImageTMP_" & ImgCollerNum & ".jpg", PathAfficheDossier & AfficheNameCouper)
                    End If
                    If FSO.FileExists(PathAfficheTMP & "ImageTMPCouper_" & ImgCouperNum & ".jpg") Then
                        Set FichierTemp = FSO.GetFile(PathAfficheTMP & "ImageTMPCouper_" & ImgCouperNum & ".jpg")
                        FichierTemp.Name = "ImageTMP_" & ImgCollerNum & ".jpg"
                    End If
                Case "D"
                    If ImgCouperNum > 9 Then
                        AfficheNameCouper = AfficheTitre & " A-" & ImgCouperNum & ".jpg"
                    Else
                        AfficheNameCouper = AfficheTitre & " A-0" & ImgCouperNum & ".jpg"
                    End If
                    If FSO.FileExists(PathAfficheDossier & AfficheNameCouper) Then
                        Set FichierTemp = FSO.GetFile(PathAfficheDossier & AfficheNameCouper)
                        FichierTemp.Name = "ImageTMPCouper_" & ImgCouperNum & ".jpg"
                    End If
                    If ImgCollerNum > 9 Then
                        AfficheNameColler = AfficheTitre & " A-" & ImgCollerNum & ".jpg"
                    Else
                        AfficheNameColler = AfficheTitre & " A-0" & ImgCollerNum & ".jpg"
                    End If
                    If FSO.FileExists(PathAfficheDossier & AfficheNameColler) Then
                        Set FichierTemp = FSO.GetFile(PathAfficheDossier & AfficheNameColler)
                        FichierTemp.Name = AfficheNameCouper
                    End If
                    If FSO.FileExists(PathAfficheDossier & "ImageTMPCouper_" & ImgCouperNum & ".jpg") Then
                        Set FichierTemp = FSO.GetFile(PathAfficheDossier & "ImageTMPCouper_" & ImgCouperNum & ".jpg")
                        FichierTemp.Name = AfficheNameColler
                    End If
            End Select
    End Select
    '-----
    ImgCouper = ""
    ImgColler = ""
    Couper_IsSelect = False
    Coller_IsSelect = False
    objForm.LblCouperW.Visible = False
    objForm.LblCouperD.Visible = False
    objForm.LblCollerW.Visible = False
    objForm.LblCollerD.Visible = False
End Sub

dans la Procédure (sub) DataFilmAfficheInverser() ,

on prépare les "composants" :
PathAfficheDossier --> Dans le PC , Dossier de toutes les Affiches ... (avant j'avais aussi un Dossier Affiche MINI que j'ai supprimé)
PathAfficheTMP --> Dans PC , Dossier Temporaire pour les Affiches avec un nom Temporaires
AfficheTitre --> le nom de "Base" (sans A-00) qui correspond au Titre du Film
Set FSO = CreateObject("Scripting.FileSystemObject") --> création de l'object "Système de Fichier"

pour l'Inversion , on utilise le Contrôle masqué (vu plus haut) ImgW100 :

Code :

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

1
2
3
4
5
 
    objForm.Controls("ImgW100").Picture = objForm.Controls(ImgCouper).Picture
    objForm.Controls(ImgCouper).Picture = objForm.Controls(ImgColler).Picture
    objForm.Controls(ImgColler).Picture = objForm.Controls("ImgW100").Picture
    objForm.Controls("ImgW100").Picture = Nothing

et on ajuste les Tailles , Num et Sélect ...
pour la suite , on utilise des "Select Case" imbriqués (plusieurs niveaux)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
    Select Case ImgCouperWD
        Case "W"
            Select Case ImgCollerWD
                Case "W"
                Case "D"
            End Select
        Case "D"
            Select Case ImgCollerWD
                Case "W"
                Case "D"
            End Select
    End Select

voyons ce bout de code qui "Renomme"

Code :

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

1
2
3
4
5
 
                    If FSO.FileExists(PathAfficheTMP & "ImageTMP_" & ImgCouperNum & ".jpg") Then
                        Set FichierTemp = FSO.GetFile(PathAfficheTMP & "ImageTMP_" & ImgCouperNum & ".jpg")
                        FichierTemp.Name = "ImageTMPCouper_" & ImgCouperNum & ".jpg"
                    End If

dans le "Système de Fichier" FSO créé plus haut ,
on contrôle si le Fichier.jpg existe : If FSO.FileExists(PathAfficheTMP & "ImageTMP_" & ImgCouperNum & ".jpg") Then
si le Fichier existe , on Pointe sur ce Fichier : Set FichierTemp = FSO.GetFile(PathAfficheTMP & "ImageTMP_" & ImgCouperNum & ".jpg")
et on le renomme en utilisant son Pointeur : FichierTemp.Name = "ImageTMPCouper_" & ImgCouperNum & ".jpg"

les Fichier TMP avant l'Inversion



les Fichier TMP après l'Inversion



quand on veut garder une Affiche PC
on "coupe" dans la Bande D et on "colle" dans la Bande W ,
dans ce cas , on déplace un fichier.jpg du Dossier "AFFICHE" vers le Dossier Temporaire ,
et on renomme le Fichier.jpg en Fichier Temporaire

Code :

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

1
2
3
4
 
                    If FSO.FileExists(PathAfficheDossier & AfficheNameCouper) Then
                        Result = FSO.MoveFile(PathAfficheDossier & AfficheNameCouper, PathAfficheTMP & "ImageTMPCouper_" & ImgCouperNum & ".jpg")
                    End If

avec FSO.MoveFile() on déplace et on renomme en même temps !!

l' Inversion dans le Form est immédiatement répercutée dans le Dossier Temporaire ,
à ce moment , les Affiches du Dossier "AFFICHE" existent toujours...

voila pour la partie AFFICHES DU FILM

@+JP

[mjpmjp]

Bonjour,

le Transfert des Data consiste a écrire et sauvegarder (toutes les infos) dans le PC

on l'a vu au tout début , il y a 2 bouton "Transfert" qui on la même fonction ,
comme il a été expliqué ,
1 bouton se trouve dans la partie Extraire --> LblTransfer1
1 bouton se trouve dans la partie Affiche --> LblTransfer2

voila le code du bouton de la frame FrmAffiche

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
 
'------------------------------------------------------- Btn Transfer 2 (FrmAffiche)
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

on connait parfaitement le mécanisme du bouton ,
passons directement a la partie Action ...

Code :

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

1
2
3
4
5
6
7
8
9
 
'action
        FormDataWebFilm_IsChangeInProgress = True
        '-----
        Call DataFilmTransfer(objFormDataWebFilm)
        Call DataFilmAfficheTransfer(objFormDataWebFilm)
        Call DataFilmFichierCreer(objFormDataWebFilm)
        '-----
        FormDataWebFilm_IsChangeInProgress = False

là encore , on signale le début et la fin des travaux avec FormDataWebFilm_IsChangeInProgress

les travaux débutent avec l'appel d'une Procédure (sub) DataFilmTransfer(objForm As Object) ,
dont le code est long , mais très simple
pour chaque groupe de "Case" jaune et gris clair de la frame FrmData , on regarde quelle "option" est à "True" : If objForm.OptionTitre = True Then
on récupère la valeur de la TextBox dans Data : Data = objForm.TxbTitre.Value
et on écrit cette valeur Data dans la Feuille/Liste/DataBase : .Cells(Ligne, ListColonNumTitre).Value = Data

notez : encore une fois , dans ce code il n'y a que des variables pour indiquer les colonnes : ListColonNumTitre ...ici , la version "num" est utilisée avec "Cells"

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
 
Public Sub DataFilmTransfer(objForm As Object)
    SheetName = DataSheetList
    Ligne = DataLigneList
    With Sheets(SheetName)
        If objForm.OptionTitre = True Then
            Data = objForm.TxbTitre.Value
        Else
            Data = objForm.TxbTitreList.Value
        End If
        .Cells(Ligne, ListColonNumTitre).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionAlias = True Then
            Data = objForm.TxbAlias.Value
        Else
            Data = objForm.TxbAliasList.Value
        End If
        .Cells(Ligne, ListColonNumAlias).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionAnnee = True Then
            Data = objForm.TxbAnnee.Value
        Else
            Data = objForm.TxbAnneeList.Value
        End If
        .Cells(Ligne, ListColonNumAnnee).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionGenre = True Then
            Data = objForm.TxbGenre.Value
        Else
            Data = objForm.TxbGenreList.Value
        End If
        .Cells(Ligne, ListColonNumGenre).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionResume = True Then
            Data = objForm.TxbResume.Value
        Else
            Data = objForm.TxbResumeList.Value
        End If
        .Cells(Ligne, ListColonNumResume).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionRealisateur = True Then
            Data = objForm.TxbRealisateur.Value
        Else
            Data = objForm.TxbRealisateurList.Value
        End If
        .Cells(Ligne, ListColonNumRealisateur).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionActeur = True Then
            Data = objForm.TxbActeur.Value
        Else
            Data = objForm.TxbActeurList.Value
        End If
        .Cells(Ligne, ListColonNumActeur).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionEcriture = True Then
            Data = objForm.TxbEcriture.Value
        Else
            Data = objForm.TxbEcritureList.Value
        End If
        .Cells(Ligne, ListColonNumEcriture).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionProduction = True Then
            Data = objForm.TxbProduction.Value
        Else
            Data = objForm.TxbProductionList.Value
        End If
        .Cells(Ligne, ListColonNumProduction).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionMontage = True Then
            Data = objForm.TxbMontage.Value
        Else
            Data = objForm.TxbMontageList.Value
        End If
        .Cells(Ligne, ListColonNumMontage).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionPhotographie = True Then
            Data = objForm.TxbPhotographie.Value
        Else
            Data = objForm.TxbPhotographieList.Value
        End If
        .Cells(Ligne, ListColonNumPhotographie).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionMusique = True Then
            Data = objForm.TxbMusique.Value
        Else
            Data = objForm.TxbMusiqueList.Value
        End If
        .Cells(Ligne, ListColonNumMusique).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionCostume = True Then
            Data = objForm.TxbCostume.Value
        Else
            Data = objForm.TxbCostumeList.Value
        End If
        .Cells(Ligne, ListColonNumCostume).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionDecor = True Then
            Data = objForm.TxbDecor.Value
        Else
            Data = objForm.TxbDecorList.Value
        End If
        .Cells(Ligne, ListColonNumDecor).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionCasting = True Then
            Data = objForm.TxbCasting.Value
        Else
            Data = objForm.TxbCastingList.Value
        End If
        .Cells(Ligne, ListColonNumCasting).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionMaquillageCoiffure = True Then
            Data = objForm.TxbMaquillageCoiffure.Value
        Else
            Data = objForm.TxbMaquillageCoiffureList.Value
        End If
        .Cells(Ligne, ListColonNumMaquillageCoiffure).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionDirectionArtistique = True Then
            Data = objForm.TxbDirectionArtistique.Value
        Else
            Data = objForm.TxbDirectionArtistiqueList.Value
        End If
        .Cells(Ligne, ListColonNumDirectionArtistique).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionChefDecoration = True Then
            Data = objForm.TxbChefDecoration.Value
        Else
            Data = objForm.TxbChefDecorationList.Value
        End If
        .Cells(Ligne, ListColonNumChefDecoration).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionAssistantRealisation = True Then
            Data = objForm.TxbAssistantRealisation.Value
        Else
            Data = objForm.TxbAssistantRealisationList.Value
        End If
        .Cells(Ligne, ListColonNumAssistantRealisation).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionSon = True Then
            Data = objForm.TxbSon.Value
        Else
            Data = objForm.TxbSonList.Value
        End If
        .Cells(Ligne, ListColonNumSon).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionEffetsSpeciaux = True Then
            Data = objForm.TxbEffetsSpeciaux.Value
        Else
            Data = objForm.TxbEffetsSpeciauxList.Value
        End If
        .Cells(Ligne, ListColonNumEffetsSpeciaux).Value = Data
    End With
    With Sheets(SheetName)
        If objForm.OptionDirectionProduction = True Then
            Data = objForm.TxbDirectionProduction.Value
        Else
            Data = objForm.TxbDirectionProductionList.Value
        End If
        .Cells(Ligne, ListColonNumDirectionProduction).Value = Data
    End With
End Sub

l'appel suivant : Call DataFilmAfficheTransfer(objFormDataWebFilm) ,
déplace , renomme les affiches sélectionnées avec le Titre du Film
efface TOUTES les autres (y compris du Dossier AFFICHE)
et pour finir , copie les affiches du Dossier Temporaire vers le Dossier AFFICHE et efface le Dossier Temporaire

à la place de copier et effacer , on pourrait déplacer , , mais avec la première solution on peut contrôler si tout est ok avant d'effacer !!

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
 
Public Sub DataFilmAfficheTransfer(objForm As Object)
    PathAfficheDossier = DriveValide & PathAffiche
    PathAfficheTMP = DriveValide & PathDataWebTMP
    PathAfficheIMG = DriveValide & PathDataWebFilmImg
    AfficheTitre = ActiveSheet.Range(ListColonTitre & ActiveCell.Row).Value
    Set FSO = CreateObject("Scripting.FileSystemObject")
    '========================================================= DEPLACE TMP
    'affiche Dossier
    For n = 0 To 99
        'le control contient une image
        If Not objForm.Controls("ImgD" & n).Picture Is Nothing Then
            If n > 9 Then
                AfficheName = AfficheTitre & " A-" & n & ".jpg"
            Else
                AfficheName = AfficheTitre & " A-0" & n & ".jpg"
            End If
            'le check est false
            If objForm.Controls("ChkD" & n).Value = False Then
                'efface l'affiche des dossiers
                If FSO.FileExists(PathAfficheDossier & AfficheName) Then Result = FSO.DeleteFile(PathAfficheDossier & AfficheName)
            Else
                'déplace l'affiche des dossiers vers TMP
                If FSO.FileExists(PathAfficheDossier & AfficheName) Then Result = FSO.MoveFile(PathAfficheDossier & AfficheName, PathAfficheTMP & "TMP_" & AfficheName)
            End If
        End If
    Next n
    '========================================================= RENOMME
    For n = 0 To 99
        If n > 9 Then
            AfficheName = AfficheTitre & " A-" & n & ".jpg"
        Else
            AfficheName = AfficheTitre & " A-0" & n & ".jpg"
        End If
        AfficheTMP = "ImageTMP_" & n & ".jpg"
        If FSO.FileExists(PathAfficheTMP & AfficheTMP) Then
            AfficheNum = n
            Set FichierTemp = FSO.GetFile(PathAfficheTMP & AfficheTMP)
            FichierTemp.Name = AfficheName
        End If
    Next n
    For n = 0 To 99
        If n > 9 Then
            AfficheTMP = "TMP_" & AfficheTitre & " A-" & n & ".jpg"
            AfficheName = AfficheTitre & " A-" & AfficheNum + 1 & ".jpg"
        Else
            AfficheTMP = "TMP_" & AfficheTitre & " A-0" & n & ".jpg"
            AfficheName = AfficheTitre & " A-0" & AfficheNum + 1 & ".jpg"
        End If
        If FSO.FileExists(PathAfficheTMP & AfficheTMP) Then
            AfficheNum = AfficheNum + 1
            Set FichierTemp = FSO.GetFile(PathAfficheTMP & AfficheTMP)
            FichierTemp.Name = AfficheName
        End If
    Next n
    '========================================================= DEPLACE FILM/IMG
    For n = 0 To 99
        If n > 9 Then
            AfficheName = AfficheTitre & " A-" & n & ".jpg"
        Else
            AfficheName = AfficheTitre & " A-0" & n & ".jpg"
        End If
        '-----
        If FSO.FileExists(PathAfficheTMP & AfficheName) Then
            Result = FSO.CopyFile(PathAfficheTMP & AfficheName, PathAfficheIMG & AfficheName, True)
            Result = FSO.DeleteFile(PathAfficheTMP & AfficheName, True)
        End If
    Next n
    '-----
    Set FSO = Nothing
End Sub

le dernier appel : Call DataFilmFichierCreer(objFormDataWebFilm) ,
toutes les infos contenues dans le Tableau TabDataFilm() sont écrites dans un Fichier.txt
ce Fichier.txt va servir (avec un autre form) pour extraire les Data des Acteurs par exemple...

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
 
Public Sub DataFilmFichierCreer(objForm As Object)
    For n = ListColonNumDebut To ListColonNumInd - 1
        TabElement = Split(TabDataFilm(n), "|")
        TabDataFilm(n) = TabElement(0) & "|" & TabElement(1) & "|" & TabElement(2) & "|" & ActiveSheet.Cells(ListLigneSelected, n).Value
    Next n
 
    PathFolder2017 = DriveValide & PathFichier & "2017\"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FichierName = objForm.Caption
    TabDataFilm(0) = FichierName
    PageTMP = PathFolder2017 & FichierName & ".txt"
    Set FichierResult = FSO.CreateTextFile(PageTMP, True, True)
    For n = 0 To 1000
        If n > 200 And TabDataFilm(n) = "" Then Exit For
        FichierResult.WriteLine (TabDataFilm(n))
    Next n
    FichierResult.Close
    Set FSO = Nothing
End Sub

voila pour la partie TRANSFERT DES DATA

pour le autres forms , je ferais une autre discussion ...

vous pouvez ajouter vos commentaires et les modifs possibles , ...

@+JP