Insertion de plusieurs images en même temps à des endroits différents

[the_tonio81]

Boujour à tous,

Je me permets de relancer le sujet des insertion des images car je n'ai pas trouvé ce que je cherche sur le forum!

En fait, je voudrais créer une macro qui me permet d'insérer plusieurs images sur des plages de cellules définies et différentes, le tout par la seule et simple action sur un bouton!

J'arrive actuellement à insérer une image mais je n'arrive pas à en insérer deux à la fois à deux endoits différents.

Je me permets de vous laisser mon code:

Sub GraphTempFig1()
' GraphTempFig1 Macro

Dim Emplacement As Range
Dim image As Object
Dim ShapeObj As Object

ActiveSheet.Pictures.Insert ("C:\Users\Tonio\Desktop\Programme Matlab\Figure1.TIF")
Set Emplacement = Range("B5:F20")

Set image = ActiveSheet.DrawingObjects(2) 'adapter selon nombre total de shapes dans feuille
With image.ShapeRange.Name = "cible" ' nommer l'image insérée
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With

Exit Sub
fin:
If Err = 1004 Then MsgBox "Insertion d'image interrompue . "
End Sub

------------------------------------------------------------
Sub Bouton1_Clic()
GraphTempFig1
End Sub

J'insère donc une image nommée Figure1 sur les cellules "B5:F20" et j'aimerai pouvoir insérer une autre image nommée Figure2 sur les cellules "C22:F34" lorsque j'actionne le bouton!

Je vous remercie par avance pour vos réponse!

Tonio

 

[myDearFriend!]

Re : Insertion de plusieurs images en même temps à des endroits différents

Bonsoir the_tonio81, le Forum,

Une façon de faire :

[COLOR=NAVY]Sub[/COLOR] TraitementImg()
[COLOR=GREEN]'myDearFriend!  -  www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] Emplacement [COLOR=NAVY]As[/COLOR] Range
[COLOR=NAVY]Dim[/COLOR] Fichier [COLOR=NAVY]As String
Dim[/COLOR] i [COLOR=NAVY]As Byte[/COLOR]

    [COLOR=NAVY]On Error GoTo[/COLOR] Fin
    [COLOR=NAVY]For[/COLOR] i = 1 [COLOR=NAVY]To[/COLOR] 2
        [COLOR=NAVY]Set[/COLOR] Emplacement = Range(Choose(i, "B5:F20", "C22:F34"))
        Fichier = "Figure" & [COLOR=NAVY]CStr[/COLOR](i)
        
        [COLOR=NAVY]With[/COLOR] ActiveSheet.Pictures.Insert("C:\Users\Tonio\Desktop\Programme Matlab\" & Fichier & ".TIF").ShapeRange
            .Name = "cible" & [COLOR=NAVY]CStr[/COLOR](i)
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        [COLOR=NAVY]End With
    Next[/COLOR] i
    
[COLOR=NAVY]Exit Sub[/COLOR]
Fin:
MsgBox "Insertion d'image interrompue."
[COLOR=NAVY]End Sub[/COLOR]

Cordialement,

 

[the_tonio81]

Re : Insertion de plusieurs images en même temps à des endroits différents

Bonsoir myDearFriend,

Merci beaucoup pour ta rapide réponse! C'est exactement ce que je voulais!
Ce forum est vraiment super et je regrette de ne pas l'avoir découvert avant...
J'espère que moi aussi un jour je pourrai poster des réponses et rendre des gens heureux!

Cordialement,

The_tonio81

 

[nerd94]

Re : Insertion de plusieurs images en même temps à des endroits différents

Bonsoir the_tonio81, le Forum,

Une façon de faire :

[COLOR=NAVY]Sub[/COLOR] TraitementImg()
[COLOR=GREEN]'myDearFriend!  -  www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] Emplacement [COLOR=NAVY]As[/COLOR] Range
[COLOR=NAVY]Dim[/COLOR] Fichier [COLOR=NAVY]As String
Dim[/COLOR] i [COLOR=NAVY]As Byte[/COLOR]

    [COLOR=NAVY]On Error GoTo[/COLOR] Fin
    [COLOR=NAVY]For[/COLOR] i = 1 [COLOR=NAVY]To[/COLOR] 2
        [COLOR=NAVY]Set[/COLOR] Emplacement = Range(Choose(i, "B5:F20", "C22:F34"))
        Fichier = "Figure" & [COLOR=NAVY]CStr[/COLOR](i)
        
        [COLOR=NAVY]With[/COLOR] ActiveSheet.Pictures.Insert("C:\Users\Tonio\Desktop\Programme Matlab\" & Fichier & ".TIF").ShapeRange
            .Name = "cible" & [COLOR=NAVY]CStr[/COLOR](i)
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        [COLOR=NAVY]End With
    Next[/COLOR] i
    
[COLOR=NAVY]Exit Sub[/COLOR]
Fin:
MsgBox "Insertion d'image interrompue."
[COLOR=NAVY]End Sub[/COLOR]

Cordialement,

Bonjour,

C'est le type de code que je recherche. Je viens de l'insérer à mon fichier et je l'ai lancé mais aucune image ne s'insère. Pouvez-vous me dire ce qui ne va pas merci. Je précise que je n'ai que quelques notions et un peu de pratique en VBA mais sans plus. Voici mon code :

Sub TraitementImg()
'myDearFriend!  -  www.mdf-xlpages.com
Dim Emplacement As Range
Dim Fichier As String
Dim i As Byte

    On Error GoTo Fin
    For i = 1 To 2
        Set Emplacement = Range(Choose(i, "C7:C9", "C11:F13", "C15:C17", "C20:C22", "C24:C26", "C28:C30", "C32:C34", "C36:C38", "C40:C42", "C44:C46", "C55:C57", "C59:C61", "C63:C65", "C68:C70", "C72:C74", "C76:C78", "C80:C82", "C84:C86", "C88:C90", "C92:C94", "C99:C101", "C104:C106", "C108:C110", "C112:C114", "C116:C118", "C120:C122", "C124:C126"))
        Fichier = "Figure" & CStr(i)
        
        With ActiveSheet.Pictures.Insert("F:\Documents\dl datas\Vidéothèque\Affiches de film" & Fichier & ".JPG").ShapeRange
            .Name = "cible" & CStr(i)
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With
    Next i
    
Exit Sub
Fin:
MsgBox "Insertion d'image interrompue."
End Sub

Je peux vous envoyer le fichier + les images par mail au cas où.
Merci d'avance pour votre feed-back.

 

[crhm]

Re : Insertion de plusieurs images en même temps à des endroits différents

Bonjour à tous ,

Un grand merci pour tout le travail réalisé sur ce forum de la part de tous les utilisateurs. Je viens vers vous concernant une VBA pour insérer "plusieurs" images "en même temps" dans une cellule dimensionnée.

J'ai déjà une formule qui marche très bien pour insérer une "seule" image. Je lance une VBA qui lance l'explorateur et je peux aller chercher ma photo. En validant, la photo prend la dimension de la cellule sélectionnée et fait "partie intégrante" de la cellule (c'est à dire qu'en effectuant des filtres, les photos disparaissent ou apparaissent comme du texte).

Je voulais savoir si il est possible de faire la même chose mais en insérant "plusieurs" photos en "même temps". Je vous donne ma première formule (qui fonctionne avec un zoom à 100% uniquement ). Pour le moment, impossible de sélectionner plusieurs photos dans l'explorateur, même en faisant la touche CTL.

Vous trouverez mon fichier test en copie et la formule ci-dessous.

Un grand merci pour vos conseils .


Public Sub insere_image()
Dim ficimg As Variant
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Top = ActiveCell.Top ' haut de la cellule
.Left = ActiveCell.Left ' gauche de la cellule
.Height = ActiveCell.RowHeight ' hauteur de la cellule
.Width = ActiveCell.Width ' largeur de la cellule
End With
With Selection
.PrintObject = True ' l'objet est imprimé en même temps que le document
.Placement = xlMoveAndSize ' manière dont l'objet est lié aux cellules
End With
End Sub