Placement images

Version imprimable

24/06/2013, 18h26
djemol

Placement images

"Bonjour"
Je pense être vraiment prés du but. J'arriverais surement à aller plus vite avec votre aide.
Je veux placer plusieurs images cote à cote et les unes en dessous des autres.
On m'a donné plusieurs exemples,mais je me demande où il faut placer les lettres et chiffres dans cette exemple:
B3 C8 E3 F8 H3 I8 ainsi de suite
et de B11 C16 E11 F16 H11 I16

Code:

range(cells(3,col),cells(8,col+5)

Encore merci
25/06/2013, 06h28
QuestVba
Hello

De cette manière tu fais une boucle pour sélectionner une zone de B3:C8, puis, E3:F8, .....
Code:

1 2 3 4 5 For col = 2 To 256 Step 3 Range(Cells(3, col), Cells(8, col + 1)).Activate Next col
25/06/2013, 11h18
Daranc

Djemol essaies de suivre une discussion sur le même fil, si tu ouvres 3 post pour le même sujet avec trois titres différents on va avoir du mal à s'y retrouver :aie:

1 pièce(s) jointe(s)

Cellement pour QuestVba

bonjour a toi

voila je te donne un exemple de la positions des images
j'aimerais vraiment que les image ce positionnes de cette façons la
je te donne le code pour une modification

merci a toi

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
Sub InsertionImage()
Dim Emplacement As Range
Dim Img As Object
Dim ShapeObj As Shape
Dim Rep As Integer
Dim Image As Integer
 
Image = 1
'Boucle pour supprimer l'ancienne image
 
For Each ShapeObj In ActiveSheet.Shapes
If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete
Next ShapeObj
line1:
If Application.Dialogs(xlDialogInsertPicture).Show Then
'Définit l'emplacement de l'image
 
 
Set Emplacement = Range("D" & Image * 3 & ":E" & Image * 3 + 2)
 
Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
With Img.ShapeRange
'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
.Name = "Cible" & Image
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With
 
Else
MsgBox "Insertion d'image interrompue."
End If
 
 
 
Rep = MsgBox("Voulez-vous continuez ?", vbYesNo + vbQuestion, "Encore une image")
If Rep = vbYes Then
Image = Image + 1
GoTo line1:
Else
' ici le traitement si réponse négative
' ...
End If
 
End Sub

Salut,

Voici un essai qui serait pas mal.

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
Sub InsertionImage()
Dim Emplacement As Range
Dim Img As Object
Dim ShapeObj As Shape
Dim Rep As Integer
Dim Image As Integer
 
Image = 1
lig = 3
colon = 2
 
'Boucle pour supprimer l'ancienne image
 
For Each ShapeObj In ActiveSheet.Shapes
If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete
Next ShapeObj
line1:
If Application.Dialogs(xlDialogInsertPicture).Show Then
'Définit l'emplacement de l'image
 
Set Emplacement = Range(Cells(lig, colon), Cells(lig + 6, colon + 1)) 'Range("D" & Image * 3 & ":E" & Image * 3 + 2)
 
Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
With Img.ShapeRange
'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
.Name = "Cible" & Image
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With
 
Else
MsgBox "Insertion d'image interrompue."
End If
 
 
Rep = MsgBox("Voulez-vous continuez ?", vbYesNo + vbQuestion, "Encore une image")
If Rep = vbYes Then
Image = Image + 1
 
If Image Mod 7 <> 0 Then lig = lig
If Image Mod 7 <> 0 Then colon = colon + 3
 
If Image Mod 7 = 0 Then lig = lig + 9
If Image Mod 7 = 0 Then colon = 2
 
 
GoTo line1:
Else
' ici le traitement si réponse négative
' ...
End If
 
 
End Sub

13/05/2018, 17h14
djemol

Bonjour

avec vraiment beaucoup de retard je vous remercie pour votre aide mais cela a fonctionner du 1er coup avec le code