Problème de variables sur deux boucles

Version imprimable

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

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:

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

Bonjour,
Pour que la valeur ta variable Cel varie dans

Code:

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:

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

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:

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

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:

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 ?

12/07/2016, 00h35
eriiic

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:

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

suffit
eric

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:

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

12/07/2016, 11h58
eriiic

Bonjour,

Si tes images sont présentes à leur places tu n'as pas à changer .top et .left mais juste hauteur et largeur.
Si elles ne sont pas dans leur cellules en vertical tu les balaies toutes dans une 1ère boucle où tu relèves .top et .name dans une variable tableau. Tu tries le tableau par .top et ensuite tu les places cellule par cellule.
eric

Bonjour Ghost, Eriic
Je peux me tromper mais le code que tu mentionnes semble devoir fonctionner, seulement tu oublis qu'il faut incrémenter ta variable i, ce que je vois pas dans

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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

Si tu essayes ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
For Each Img In Workbooks(1).Sheets("BDD").Shapes
                    Img.LockAspectRatio = msoFalse
 
                    Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83

     WithSheets("BDD")
        NbLigne = .Cells(.Rows.Count, 1).End(xlUp).Row -3 ' Compte le nombre de ligne de la feuille (-3 car tu commence ligne 3)
     End With
 
                    For i=4 To Nbligne ' i va s'incrementer en fonction du nombre de lignes
                    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 i
                    Next Img

Eric

Bonjour tout le monde;

Alors, je viens de tester ton code, celui-ci (j'ai enlevé le -3 car toutes mes images se sont retrouvés dans la mauvaise cellule), maintenant toutes mes images se retrouvent au sein de la dernière cellule de la colonne C.

Je pense personnellement que ton code est bon, mais que la boucle "For i = 3 to Nbligne" ne compte pas une à une les cellules en y redimensionnant les images.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 For Each Img In Workbooks(1).Sheets("BDD").Shapes Img.LockAspectRatio = msoFalse Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83 With Workbooks(1).Sheets("BDD") Nbligne = .Cells(.Rows.Count, 1).End(xlUp).Row End With For i = 3 To Nbligne ' i va s'incrementer en fonction du nombre de lignes 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 i Next Img

12/07/2016, 13h55
eric4459

Rebonjour,
Je n'avais pas prêté attention à cela

Code:

For Each Cel In Workbooks(1).Sheets("BDD").Range("C3:C" & i).Rows

Il me semble que l'on se mélange les pinceaux, en effet on essaye de faire référence à une cellule alors que l'on demande un peu n'importe quoi : travailler sur une colonne variable

Code:

.Range("C3:C" & i)

et sur une ligne

Code:

.Rows

Le problème vient de cette incoherence.
Et si tu essayais

Code:

For Each Cel In Workbooks(1).Sheets("BDD").Range("C" & i)

Tiens nous au courant
Eric

Hummmmm ...

Alors, j'ai fais un msgbox i et "i" prend toujours la même valeur, c'est à dire "14", je pense que c'est pour ça que les images sont dans la même cellule... en fait la boucle For ne se réalise pas on dirait...

Le code que j'ai testé :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
For Each Img In Workbooks(1).Sheets("BDD").Shapes
Img.LockAspectRatio = msoFalse
Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83

With Workbooks(1).Sheets("BDD")
    Nbligne = .Cells(.Rows.Count, 1).End(xlUp).Row ' Compte le nombre de ligne de la feuille (-3 car tu commence ligne 3)
End With
 
                    For i = 3 To Nbligne ' i va s'incrementer en fonction du nombre de lignes
                       For Each Cel In Workbooks(1).Sheets("BDD").Range("C" & i)
                       Cel.RowHeight = 146.25
                            With Img
                                .Left = Cel.Left
                                .Top = Cel.Top
                                .Width = Cel.Width
                                .Height = Cel.Height
                            End With
                       Next Cel
                    Next i
                    MsgBox i
Next Img

Ghost,
Faut que tu mettes ton MsgBox ici ;)

Code:

1
2
3
4
            End With
                       Next Cel
                    MsgBox i
                    Next i

Eric

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
For Each Img In Workbooks(1).Sheets("BDD").Shapes
Img.LockAspectRatio = msoFalse
Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83

With Workbooks(1).Sheets("BDD")
    nbligne = .Cells(.Rows.Count, 1).End(xlUp).Row ' Compte le nombre de ligne de la feuille (-3 car tu commence ligne 3)
End With
 
                    For i = 3 To nbligne ' i va s'incrementer en fonction du nombre de lignes
                       For Each Cel In Workbooks(1).Sheets("BDD").Range("C" & i)
                       Cel.RowHeight = 146.25
                            With Img
                                .Left = Cel.Left
                                .Top = Cel.Top
                                .Width = Cel.Width
                                .Height = Cel.Height
                            End With
                       Next Cel
                    Next i
Next Img

La boucle en bleu s'exécute bien, mais une fois que i de 3 à 13 est réalisé, le code passe à "Next Img", hors, il faudrait affecter une image à une ligne, c'est ça le truc je pense, ici, on affecte pas une ligne à une image, on test les lignes 3 à 13 sans utilisé les images j'ai l'impression ???

Ghost,
Essayes sans variable i.

En effet on demande :

Code:

1
2
3
Pour chaque Cel contenue dans le range C3:C & un nombre fixe correspondant au nombre de cellule dans lesquelle il faut agir
ACTION
Prochaine Cellule

:oops:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
For Each Img In Workbooks(1).Sheets("BDD").Shapes
Img.LockAspectRatio = msoFalse
Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83
 
With Workbooks(1).Sheets("BDD")
    Nbligne = .Cells(.Rows.Count, 1).End(xlUp).Row ' Compte le nombre de ligne de la feuille (-3 car tu commence ligne 3)
End With
 
 
                       For Each Cel In Workbooks(1).Sheets("BDD").Range("C3:C" & Nbligne)
                       Cel.RowHeight = 146.25
                            With Img
                                .Left = Cel.Left
                                .Top = Cel.Top
                                .Width = Cel.Width
                                .Height = Cel.Height
                            End With
                       Next Cel
 
Next Img

Peux-tu envoyer un fichier en piece jointe, car je me demande si on a vraiment besoin de

Code:

1
2
3
For Each Img In Workbooks(1).Sheets("BDD").Shapes
Img.LockAspectRatio = msoFalse
Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83

Je pense que l'on pourrai l’intégrer dans la boucle

Code:

For each Cel in ...

Eric

12/07/2016, 15h08
Ghost0000

Je te passe le fichier, c'est dans l'userform "Mise_en_Forme" au moment de "userform_initialize" :

Renomme le fichier Relevés dim 2.xlsm avec l'extension XLSB et ca devrait fonctionner (car l'import ne fonctionner pas sinon)
12/07/2016, 15h20
eric4459

1 pièce(s) jointe(s)

Ghost,
Peux-tu utiliser la fonctionnalité inclue car je ne peux télécharger tes fichier sur le net (Pb de sécurité)
Pièce jointe 215274
Eric
12/07/2016, 15h26
Ghost0000

Revoir mon post plus haut, y'a les fichiers :)

1 pièce(s) jointe(s)

Ghost,
Problème sur le fichier ?
Pièce jointe 215282

Peux-tu essayer ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
          For Each Img In Workbooks(1).Sheets("BDD").Shapes
                        Img.LockAspectRatio = msoFalse
                   Next Img
 
                    Workbooks(1).Sheets("BDD").Columns("C:C").ColumnWidth = 83
 
                    With Workbooks(1).Sheets("BDD")
                        Nbligne = .Cells(.Rows.Count, 1).End(xlUp).Row ' Compte le nombre de ligne de la feuille (-3 car tu commence ligne 3)
                    End With
 
 
                    For Each Cel In Workbooks(1).Sheets("BDD").Range("C3:C" & Nbligne)
                    Cel.RowHeight = 146.25
 
                    With Img
                        .Left = Cel.Left
                        .Top = Cel.Top
                        .Width = Cel.Width
                        .Height = Cel.Height
                    End With
 
                    Next Cel

Dans un premier temps, tu autorises la modification des dimensions de toutes tes images, ensuite tu modifie la largeur de ta colonne et enfin tu repositionne tes images.

Eric

12/07/2016, 16h41
Ghost0000

Le problème sur le fichier provient de l'extension XLSM, il faut mettre le fichier "Relevés dimensionnel 2" en ".XLSB".

J'ai essayé ton code, les images se positionne bien au niveau des cellules, mais elles ne se redimensionnent pas.

Regarde plutôt :
'NON DISPONIBLE'

GK

J'ai essayé ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
                    'Redimensionnement de la colonne C :
                    With Workbooks(1).Sheets("BDD")
                        nbligne = .Cells(.Rows.Count, 1).End(xlUp).Row
                        Columns("C:C").ColumnWidth = 83
                        Range("C3:C" & nbligne).RowHeight = 146.25
                    End With
 
                    'Redimensionnement des images au sein de chaque cellules de la colonne C (à partir de C3 jusqu'à nbligne)
                        For Each Cel In Workbooks(1).Sheets("BDD").Range("C3:C" & nbligne).Rows
                        ro = Cel.Row
                        Img = Workbooks(1).Sheets("BDD").Shape(ro)
                                With Img
                                    .LockAspectRatio = msoFalse
                                    .Left = Cel.Left
                                    .Top = Cel.Top
                                    .Width = Cel.Width
                                    .Height = Cel.Height
                                End With
                        Next Cel

Alors :

1- Mes cellules de la colonne C se redimensionne bien (hauteur et largeur) --> pas de souci là dessus
2- Je pense que mon redimensionnement d'images par rapport aux cellules de la colonne C fonctionne mais, ma variable "ro" renvoie une mauvaise valeur, il faudrait sélectionner les images de la feuille -> problème, elles portent un nom différents à chaque import : faut'il les rénommer de manière incrémentale ?

Je vais continuer à réfléchir sur ça ce soir.

Merci de votre aide.

GK

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