Problème de variables sur deux boucles

**Ghost0000** · 10/07/2016, 22h35

Bonjour,

Je souhaiterais dimensionner des images en fonction de la hauteur de plusieurs cellules. (une image = une cellule excel)

Le problème vient du fait que je n'arrive pas à affecter la valeur de la variable "cel" à la boucle "For each" suivante, ce qui fait que mes images se trouvent toutes au même endroit (dans la dernière cellule)

Voici mon code : (en rouge la valeur "Cel" que je n'arrive pas à faire varier par rapport à la première boucle: comment faire ? La valeur "Cel" prise en compte par la seconde boucle correspond à la dernière ligne "i")

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
                    'Mise en forme des cellules
                    Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83
                    
                    For Each cel In Workbooks(1).Sheets("BDD").Range("C3:C" & i).Rows
                    cel.RowHeight = 146.25
                    Next cel
                    
                    'Mise en forme des images
                    For Each Img In Workbooks(1).Sheets("BDD").Shapes
                    Img.LockAspectRatio = msoFalse
                    
                    With Img
                        .Left = cel.Left
                        .Top = cel.Top
                        .Width = cel.Width
                        .Height = cel.Height
                    End With
                    
                    Next Img

Vous remerciant par avance.

Cordialement.

GK

**eric4459** · 11/07/2016, 12h19

Bonjour,
Pour que la valeur ta variable Cel varie dans

Code :

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

1
2
3
4
5
6
7
8
 With Img
.Left = cel.Left
.Top = cel.Top
.Width = cel.Width
.Height = cel.Height
End With
 
Next Img

il faut l'inclure dans une boucle également, essayes ceci, sinon copie ton code en globalité afin que l'on puisse mieux comprendre.

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
 For Each Img In Workbooks(1).Sheets("BDD").Shapes
                    Img.LockAspectRatio = msoFalse
 
                    'Mise en forme des cellules
                    Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83
 
                    For Each cel In Workbooks(1).Sheets("BDD").Range("C3:C" & i).Rows
                    cel.RowHeight = 146.25
 
 
                    With Img
                        .Left = cel.Left
                        .Top = cel.Top
                        .Width = cel.Width
                        .Height = cel.Height
                    End With
 
                    Next cel
                    Next Img

Eric

**Ghost0000** · 11/07/2016, 18h30

J'ai essayé ton code, ça me fait pareil, toutes les images sont bien dans la dernière cellule (redimensionné et tout mais pas dans chaque cellule de manière indépendante)

Voici tous mon 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
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
Private Sub UserForm_Initialize()
'Accueil
Sheets("Accueil").Activate
ActiveSheet.Protect Sheets("Reglages").Range("I9").Value

'Initialisation de l'userform "Mise en forme"
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayFullScreen = True
Application.DisplayExcel4Menus = False
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = False
ActiveWindow.DisplayHeadings = False

'Cacher les onglets
ActiveWindow.DisplayWorkbookTabs = False

'Masquer le bouton "Croix de fermeture"
Dim hSysMenu As Long
Dim MeHwnd As Long
    MeHwnd = FindWindowA(vbNullString, Me.Caption)
    If MeHwnd > 0 Then
        hSysMenu = GetSystemMenu(MeHwnd, False)
        RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
    Else
        MsgBox "Handle de " & Me.Caption & " Introuvable", vbCritical
    End If

'---------------------------------------------------------------Import de la BDD depuis le chemin indiqué-----------------------------------------------------------------
    'Initialisation des variables de traitements
    Dim repertoire As String, Fichier As String
    Dim DateModifFichier As Date
    
        repertoire = Workbooks(1).Sheets("Reglages").Range("I12").Value
        
        'Si il n'y a pas de fichier dans le répertoire alors ...
        If repertoire = "" Then
'erreur1004:
            MsgBox "La base de données est introuvable." & Chr(10) & "Merci d'entrer à nouveau le chemin de destination de la base de données depuis le menu 'Réglages' (Roue crantée)", vbCritical
            GoTo ici
        End If

                    'Ouverture du fichier
                    Workbooks.Open (repertoire), ReadOnly:=True
                    
'----------------------------Récupération du range de la BDD permettant de copier-coller intégralement les données externes :----------------------------------------------
                    
                    'Suppression de la BDD du formulaire
                    Workbooks(1).Sheets("BDD").Cells.Clear
                    For Each Pic In Workbooks(1).Sheets("BDD").Pictures
                    Pic.Delete
                    Next Pic
                    
                    'i correspond à la dernière ligne de la colonne A de la BDD
                    i = Workbooks(2).Sheets("BDD").Range("A" & Rows.Count).End(xlUp).Row

                    'j correspond à la dernière colonne de la BDD
                    nbcol = Workbooks(2).Sheets("BDD").Cells(1, Cells.Columns.Count).End(xlToLeft).Column      'on récupère le numéro de la dernière colonne
                    j = Split(Cells(1, nbcol).Address, "$")(1)                                                 'on convertir le numéro en "lettre Colonne"

                    'k correspond à la dernière ligne de la dernière colonne de la BDD
                    k = Workbooks(2).Sheets("BDD").Range(j & Rows.Count).End(xlUp).Row                         'On recupère le numéro de la dernière ligne (dernière colonne)

                    'Voici le copier/coller des données du formulaire en direction de la BDD
                    Workbooks(1).Sheets("BDD").Range("A" & i & ":" & j & k).Value = Workbooks(2).Sheets("BDD").Range("A" & i & ":" & j & k).Value
                    
                    'Copier/coller des données de la BDD
                    Workbooks(2).Sheets("BDD").Activate
                    Cells.Select
                    Selection.Copy
                    Workbooks(1).Sheets("BDD").Activate
                    Cells.Select
                    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone
                    ActiveSheet.Paste


'ton code que j'ai testé ici :
                    For Each Img In Workbooks(1).Sheets("BDD").Shapes
                    Img.LockAspectRatio = msoFalse

                    Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83
 
                    For Each cel In Workbooks(1).Sheets("BDD").Range("C3:C" & i).Rows
                    cel.RowHeight = 146.25
 
                    With Img
                        .Left = cel.Left
                        .Top = cel.Top
                        .Width = cel.Width
                        .Height = cel.Height
                    End With
 
                    Next cel
                    Next Img
                  
                    
                    Application.CutCopyMode = False
              
                    'Copier/coller des en-têtes de la BDD
                    Workbooks(2).Sheets("BDD").Activate
                    Rows("1:2").Select
                    Selection.Copy
                    Workbooks(1).Sheets("BDD").Activate
                    Rows("1:2").Select
                    ActiveSheet.Paste

                    'Mise en forme des cellules (mode tableau)
                    Cells.Select
                    Application.CutCopyMode = False
                    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With Selection.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With Selection.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With Selection.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With Selection.Borders(xlInsideVertical)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With Selection.Borders(xlInsideHorizontal)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    
                    'Mise en forme (Centrage des lignes et colonnes)
                    With Selection
                        .VerticalAlignment = xlBottom
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                    End With
                    With Selection
                        .HorizontalAlignment = xlRight
                        .VerticalAlignment = xlBottom
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                    End With
                    With Selection
                        .HorizontalAlignment = xlRight
                        .VerticalAlignment = xlCenter
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                    End With
                    With Selection
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                    End With
                    
                    Workbooks(2).Close (False)

ici:
' //Combobox "Ressource"
    Dim l1 As Long 'déclare la variable l1 (Ligne de Fin)
    Dim u As String
    Dim r As String
    Dim s As String
    
    Sheets("BDD").Select
        l1 = Range("A65536").End(xlUp).Row 'définit la variable l1
        ComboBox1.Clear 'vide la ComboBox1
        
        For Each Col In Sheets("BDD").Range("A:A")
        u = 0
            If Col = "Article" Then
            r = u
            's = Split(Cells(0, r).Address, "$")
            End If
        Next
        u = u + 1

        'remplit la ComboBox
        For Each cel In Range("A2:A" & l1) 'boucle sur toutes les cellule de A2 à A_l1
        'condition : si la cellule n'est pas vide ajoute son contenu à la ComboBox1
        If cel.Value <> "" Then ComboBox1.AddItem cel.Value
        Next cel 'prochaine cellule

' //Combobox "Instruments"
    Dim l3 As Long 'déclare la variable l1 (Ligne de Fin)
    Sheets("Reglages").Select
        l3 = Range("B65536").End(xlUp).Row 'définit la variable l2
        ComboBox3.Clear 'vide la ComboBox1
        'remplit la ComboBox
        For Each cel In Range("B2:B" & l3) 'boucle sur toutes les cellule de A2 à A_l1
        'condition : si la cellule n'est pas vide ajoute son contenu à la ComboBox1
        If cel.Value <> "" Then ComboBox3.AddItem cel.Value
        Next cel 'prochaine cellule

Sheets("Accueil").Activate

'Update du Screen (Mise en forme - centrage de l'affichage)
 ActiveWindow.ScrollColumn = 1
 ActiveWindow.ScrollRow = 1
 Range("A1:K40").Select 'ici tu selectionne la plage que tu veux elle sera zommée pour remplir tout l'ecran quelque se soit la resolution de ton ecran
 ActiveWindow.Zoom = True
 Range("G9").Select

Sheets("Accueil").EnableSelection = xlLockedCells
Application.ScreenUpdating = True
End Sub

Merci de ton aide !

GK

**Ghost0000** · 11/07/2016, 20h38

J'ai essayé ça, mais sans succès, en fait, mes images portent des noms différents à chaque import de la BDD (à l'ouverture de mon classeur) : Image 34 .... Image 35 .... Image 166 ....
J'ai d'abord pensé à les renommer mais cela crash excel .... (code en commentaires)

Le plus difficile pour moi, c'est de lier une image à un numéro de cellule. Ici je commence à la ligne 3... donc en C3 y'a la première image...

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
           'Renommage des images :
'                    m = 3
'                    For Each Pict In Workbooks(1).Sheets("BDD").Picture
'                    Pict.Name = "Picture" & m
'                    m = m + 1
'                    Next Pict
 
 
                    'Mise en forme des images
                    Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83
                    For Each Cel In Workbooks(1).Sheets("BDD").Range("C3:C" & i).Rows
                    Cel.RowHeight = 146.25
                    ro = Cel.Row
 
                    Img = Workbooks(1).Sheets("BDD").Picture("Picture" & ro)
                    With Img
                        .LockAspectRatio = msoFalse
                        .Left = Cel.Left
                        .Top = Cel.Top
                        .Width = Cel.Width
                        .Height = Cel.Height
                    End With
 
                    Next Cel

Pas d'idées sur ce sujet ?

**eriiic** · 12/07/2016, 00h35

Bonjour,

pour chaque img utilise la propriété .topLeftCell pour avoir le range du coin supérieur gauche. Tu sauras où elle est.
Tu as également .bottomRightCell au cas où...
Mais tu n'expliques pas le fonctionnement, si elles sont présentes (ce que j'ai supposé) ou ajoutées (auquel cas les placer au fur et à mesure)

Et pour les hauteurs de lignes pas besoin de boucle.

Code :

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

Range("C3:C" & i).RowHeight = 146.25

suffit
eric

**Ghost0000** · 12/07/2016, 09h35

Concernant le fonctionnement, le voici :

1- A l'ouverture de mon fichier Excel (XLSB), j'importe de manière automatique une base de données (fichier XLSX) et je colle ces données au sein du sheet "BDD" de mon fichier XLSB, ensuite je ferme la base de donnée (xlsx).
Ce qu'il faut comprendre, ce que dans la base de données (XLSX), il y a des images dans chaque cellules de la colonne C (à partir de la ligne 3), que j'importe aussi dans mon fichier XLSB (d'où ma demande pour un code d'adaptation des images en fonction de la hauteur / longueur des cellules de cette colonne).

2- L'import se réalise comme suit :
a- Suppression des anciennes données du Sheet "BDD" (et des anciennes images contenu dans ce sheet avec une boucle)
b- Import du range adéquate (là où il y a de la données en gros) du ficher XLSX au fichier XLSB (sheet "BDD")
c- Import des images et adaptation des dimensions de l'image --> Jai donc un souci à ce niveau là.
d- La BDD XLSX se ferme
e- Je peux maintenant lancer mon userform "Mise_En_Forme" qui conditionne mon document ... après cela fonctionne bien

@Eriiic : Mes images sont bien présentes dans le Sheet("BDD") de mon fichier XLSB au moment où j'effectue la mise en forme (vu avec le mode pas à pas), donc mon import est bien réalisé, c'est la mise en forme où j'ai du mal.

Ici le code de l'import :

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
                    'Copier/coller des données de la BDD
                    Workbooks(2).Sheets("BDD").Activate
                    Cells.Select
                    Selection.Copy
                    Workbooks(1).Sheets("BDD").Activate
                    Cells.Select
                    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone
                    ActiveSheet.Paste
 
                    'Ici, j'ai collé les données et les images dans le Sheets("BDD")
 
'ton code que j'ai testé ici :
                    For Each Img In Workbooks(1).Sheets("BDD").Shapes
                    Img.LockAspectRatio = msoFalse
 
                    Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83
 
                    For Each cel In Workbooks(1).Sheets("BDD").Range("C3:C" & i).Rows
                    cel.RowHeight = 146.25
 
                    With Img
                        .Left = cel.Left
                        .Top = cel.Top
                        .Width = cel.Width
                        .Height = cel.Height
                    End With
 
                    Next cel
                    Next Img

Merci Eriiic pour ces informations, je vais tester ce soir.

Cordialement.

GK

Problème de variables sur deux boucles [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager