copie d'image multiple...

[pasglop]

Re-bonsoir

2eme questions de la soirée ... (c'est sa quand on n'est bon, on vous lâche plus !!)

Est il possible d'incéré la même image dans plusieurs cellules cote à cote le nombre de copie étant une variable ...

Je voudrais que l'image :
C:\essai.jpg
Soit copier dans la cellule B2 et dans les colonnes suivantes en fonction d'une variable en A1 :

Si A1=2 alors "essai.jpg" sera en B2 et C2
Si A1=3 alors "essai.jpg" sera en B2 C2 et D2
Etc.

Sur se coup là je ne trouve rien de bien convaincant dans les aides ou dans les recherches donc je ne sais même pas sur quelle base partir ...?

Pourriez vous m'aider, Merci

Yves

 

[Cousinhub]

Re : copie d'image multiple...

Bonsoir,

ce code, qui fonctionne sans sélection....(), te permet de choisir une image dans le dossier qui va bien, et la copie autant de fois que tu veux, dans la ligne 2, à partir de la colonne B.

L'image se cale dans la cellule, et prend la taille de la cellule....

On peut adapter, bien évidemment....

Sub Macro14()
For Each sh In ActiveSheet.Shapes
    If Left(sh.Name, 5) = "Image" And sh.TopLeftCell.Row = 2 Then sh.Delete
Next sh
If [A1] > 0 Then
chemin = Application.GetOpenFilename("Text Files (*.jpg), *.jpg")
For i = 1 To [A1]
    With Cells(2, i + 1)
        ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Left:=.Left, _
            Top:=.Top, Width:=.Width, Height:=.Height).Select
    End With
Next i
For Each sh In ActiveSheet.OLEObjects
    If sh.TopLeftCell.Row = 2 And Left(sh.Name, 5) = "Image" Then
        With sh.Object
            .PictureSizeMode = 1
            .Picture = LoadPicture(chemin)
        End With
    End If
Next sh
End If
[A1].Select
End Sub

 

[pasglop]

Re : copie d'image multiple...

merci pour la réponse,
je vais voir si sa marche ...

A+
yves

 

[Cousinhub]

Re : copie d'image multiple...

Bonsoir,

Afin de t'éviter toute excuse ultérieure, ce code, comme tous les codes que je fournis, en général, fonctionne......(pour peu que je puisse le tester sur un fichier exemple, bien sûr....)

Private Joke

 

[pasglop]

Re : copie d'image multiple...

se que je voulais dire ….

Je vais voir si j'arrive à le faire fonctionner avec mes connaissances limitées d'Excel ...

Je ne doutais pas que cela fonctionne !! (Merci encor … )

A+
Yves

 

[pasglop]

Re : copie d'image multiple...

Donc voila,
Sa marche tip top merci

Maintenant pourrais tu m'expliquer à quel endroit dans le code tu lui demande de copier l'image sur les 4 cases consécutive ?

Et pourrais tu aussi me montrer comment on fait pour l'image s'incère en gardant sa taille original ?

Merci d’avance
Yves

 

[Cousinhub]

Re : copie d'image multiple...

Re-,

le principe, que j'ai adopté, en accord avec moi-même.........

Plutôt que d'insérer une image(.jpg) dans le classeur, j'insère un contrôle "Image", issu de la barre d'outils "Contrôles"...

Avant tout, je supprime toutes les images, sur la ligne 2

For Each sh In ActiveSheet.Shapes
    If Left(sh.Name, 5) = "Image" And sh.TopLeftCell.Row = 2 Then sh.Delete
Next sh

Si le nom de l'objet commence par "Image", et qu'il se situe en ligne 2, "Diwal", comme on dit en breton, "Supprimer", en français...

Ensuite, je fais une boucle, de 1 à la valeur de la cellule A1...

Si la valeur est supérieure à 0, j'insère une "Image", issu de la barre d'outils "Contrôles"

Et ensuite, dans chaque "Image", le :

.PictureSizeMode = 1

Te permet d'avoir l'image en entier (F1, pour l'aide)

et le :

.Picture = LoadPicture(chemin)

Te permet de charger ton image, dans le contrôle "Image"

Bonne soirée

 

[Cousinhub]

Re : copie d'image multiple...

Re,

Et effectivement, pas exactement répondu....

Pour le nombre d'images, cela se passe sur cette boucle :

For i = 1 To [A1]
    With Cells(2, i + 1)
        ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Left:=.Left, _
            Top:=.Top, Width:=.Width, Height:=.Height).Select
    End With
Next i

Juste qu'une fois que tu as lancé le code, même en pas-à-pas, tu ne peux plus rien faire.......(d'où le plaisir de développer des codes.......)