Afficher x images selon x

**alexlg35** · 27/02/2015, 12h01

Bonjour,

Je suis actuellement en train de réaliser un programme sous visual basic et j'aurai besoin de votre aide concernant l'affichage des images.
En effet, j'aimerai afficher X images les unes en dessous des autres selon la valeur d'une cellule, puis ensuite avoir Y cette colonne d'images selon la valeur d'une deuxième cellule.

Je précise que j'ai longuement cherché sur le web et que vous êtes désormais mon derniers recours puisque mes recherches ont été infructueuses...

J'espère que j'ai été assez clair dans l'énonciation de la problématique.

En vous souhaitant un très bon vendredi !

**mercatog** · 27/02/2015, 12h18

Il faudra être plus précis
Les images sont elles sur le classeur ou bien un fichier
Les X Y images sont identiques ou différentes

**alexlg35** · 27/02/2015, 12h23

Tout d'abord, merci pour votre réponse.

Excusez moi pour mon manque de précision.

Les images seraient dans le classeur, elles seront toutes identiques.
Finalement, il s'agit de dupliquer en ligne et colonne une image déjà présente dans le classeur selon X et Y.

**mercatog** · 27/02/2015, 13h19

Un exemple: Dupliquer X Y fois une image contenue sur la même feuille

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
'Shp: l'image à copier sur la même feuille
'Cel: la cellule à partir de laquelle la duplication commence
'X: le nombre de copies verticales
'Y: le nombre de copies horizontales
 
Private Sub PictureDuplicate(ByVal Shp As Shape, ByVal Cel As Range, ByVal X As Integer, ByVal Y As Integer)
Dim i As Integer, j As Integer
Dim G As Double, H As Double
 
H = Cel.Top
With Shp
    For i = 1 To X
        G = Cel.Left
        For j = 1 To Y
            .Duplicate
            With .Parent
                With .Shapes(.Shapes.Count)
                    .Left = G
                    .Top = H
                End With
            End With
            G = G + .Width
        Next j
        H = H + .Height
    Next i
End With
End Sub

Par exemple: dupliquer sur la feuille nommée Feuil2 l'image Image 1 autant de fois que les valeurs verticales en A1 et horizontales en B1

Code :

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

1
2
3
4
5
6
Sub test()
 
With Worksheets("feuil2")
    PictureDuplicate .Shapes("Image 1"), .Range("C10"), .Range("A1"), .Range("B1")
End With
End Sub

**kiki29** · 27/02/2015, 14h01

Salut, par curiosité regarde ici ( il s'agit ici de fichiers pdf mais le principe est transposable )

dans la procédure PosShapesIns, cette partie devrait t'intéresser, enfin je pense.

Voir une copie d'écran ici pour visualiser la manière dont les pdf sont positionnés

Code :

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

1
2
3
4
5
6
7
8
9
10
11
    .....
    Nb = ShParam.Range("NbPagesH")
    For i = LBound(Tablo) To UBound(Tablo)
        L = (i Mod Nb) * (W + Pas)
        T = (i \ Nb) * (H + Pas)
        With ShRecap.Shapes(Tablo(i))
            .Left = L
            .Top = T
        End With
    Next i
    .....

**alexlg35** · 27/02/2015, 14h12

Merci Mercatog pour ta réponse ! Comme vous pouvez vous en rendre compte je suis débutant dans ce domaine, à vrai dire c'est pour un projet de recherche pour le Master Energétique que j'étudie, nous n'avons jamais fais de VBA..

Je ne comprends pas comment assigner la variable Shp à mon image afin qu'elle puisse être intégrée dans le programme.

Merci beaucoup pour votre aide.

Kiki29, je regarde de suite le lien, j'espère que cela ne sera pas trop chinois pour moi

**mercatog** · 27/02/2015, 14h35

Envoyé par alexlg35

Je ne comprends pas comment assigner la variable Shp à mon image afin qu'elle puisse être intégrée dans le programme.

Dans la procédure test, tu as le nom de ton image à adapter

**alexlg35** · 27/02/2015, 14h43

Envoyé par mercatog

Un exemple: Dupliquer X Y fois une image contenue sur la même feuille

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
'Shp: l'image à copier sur la même feuille
'Cel: la cellule à partir de laquelle la duplication commence
'X: le nombre de copies verticales
'Y: le nombre de copies horizontales
 
Private Sub PictureDuplicate(ByVal Shp As Shape, ByVal Cel As Range, ByVal X As Integer, ByVal Y As Integer)
Dim i As Integer, j As Integer
Dim G As Double, H As Double
 
H = Cel.Top
With Shp
    For i = 1 To X
        G = Cel.Left
        For j = 1 To Y
            .Duplicate
            With .Parent
                With .Shapes(.Shapes.Count)
                    .Left = G
                    .Top = H
                End With
            End With
            G = G + .Width
        Next j
        H = H + .Height
    Next i
End With
End Sub

Par exemple: dupliquer sur la feuille nommée Feuil2 l'image Image 1 autant de fois que les valeurs verticales en A1 et horizontales en B1

Code :

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

1
2
3
4
5
6
Sub test()
 
With Worksheets("feuil2")
    PictureDuplicate .Shapes("Image 1"), .Range("C10"), .Range("A1"), .Range("B1")
End With
End Sub

J'ai réussi à faire marcher ce code, en mettant bien le nom correspondant de l'image dans le code, quel joie quand j'ai vu les images se dupliquer lol

Mais cela n'a fonctionné qu'une fois ! Maintenant j'ai un message d'erreur "Mémoire insuffisante"...

**alexlg35** · 27/02/2015, 16h19

Ok, le programme fonctionne et je t'en remercie Mercatog !

Aurais-tu une idée afin qu'à chaque "clic" sur le bouton qui démarre ma macro, on commence par effacer tous les shapes ?
Car une fois que ceux-ci sont affichés, ils restent affichés de façon permanente.

Je ne sais pas si je m'exprime de façon assez claire..

Merci encore

**mercatog** · 27/02/2015, 16h52

Tu fais une boucle sur tes shapes et tu supprimes les images portant le nom désiré.
On copie au préalable une image et on la colle après suppression pour ne garder qu'une à la fin (gymnastique)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub DeletDuplicatedShapes()
Dim Shp As Shape
 
With Worksheets("Feuil2")
    .Shapes("Image 1").Copy
    For Each Shp In .Shapes
        If Shp.Type = msoPicture Then
            If Shp.Name = "Image 1" Then Shp.Delete
        End If
    Next Shp
    .Paste
End With
End Sub

**alexlg35** · 27/02/2015, 18h00

Je viens de m'en rendre compte qu'avec l'opération copier/coller, l'image est collée un peu n'importe ou à la fin.. Serait-il possible de supprimer tous les shapes, sauf le modèle (Image 1) et bien sur conserver le bouton de lancement.

En effet, j'ai essayé ce code ci mais il me supprime tout, même image 1 et mon bouton de lancement.. Je pense ne pas avoir toutes les connaissances requises pour effectuer ce genre de choses qui doit être finalement très simple..

Code :

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

1
2
3
4
5
6
7
8
Sub suppr()
For Each s In Shapes
    If s.Name <> "Image 1" Then
        s.Delete
    End If
Next
 
End Sub

Edit : j'ai joins mon fichier

Classeur test copie image.xlsm

**mercatog** · 28/02/2015, 15h09

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub DeletDuplicatedShapes()
Dim Shp As Shape
Dim c As Integer
 
With Worksheets("Feuil2")
    For Each Shp In .Shapes
        If Shp.Type = msoPicture Then
            c = c + 1
            If c > 1 Then Shp.Delete
        End If
    Next Shp
End With
MsgBox c - 1 & " image(s) supprimée(s)"
End Sub

On ne supprime pas la première image

**alexlg35** · 28/02/2015, 15h15

Merci beaucoup c'est génial ! Cela fonctionne sur mon fichier test
Je passe le post en résolu. Encore merci, passez un bon week end Mercatog

**alexlg35** · 28/02/2015, 18h57

Je me permet de revenir sur le post car j'ai (encore) un soucis..

En effet, la duplication d'image ne se fait pas dans la cellule que j'ai demandée, mais sur mon image référence légèrement en décalé...
Pourtant, j'ai copié/collé le code de mon fichier test dans celui sur lequel je travaille.

Pourrais-tu Mercatog, s'il te plait, jeter un coup d'oeil au fichier ci dessous ?

En te remerciant par avance.

Tableau Programme .xlsm

**alexlg35** · 28/02/2015, 19h27

Par tatonnement j'ai trouvé le problème..

Je ne savais pas qu'un commentaire de cellule pouvait mettre le désordre dans l'affichage de mes images, si quelqu'un a une explication je suis preneur.

Merci

**mercatog** · 28/02/2015, 22h14

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
Private Sub PictureDuplicate(ByVal Shp As Shape, ByVal Cel As Range, ByVal X As Integer, ByVal Y As Integer)
Dim i As Integer, j As Integer
Dim G As Double, H As Double
 
H = Cel.Top
With Shp
    For i = 1 To X
        G = Cel.Left
        For j = 1 To Y
            With .Duplicate
                .Left = G
                .Top = H
            End With
            G = G + 1.5 * .Width
        Next j
        H = H + 1.2 * .Height
    Next i
End With
End Sub

**alexlg35** · 03/03/2015, 14h34

Je me permet de revenir concernant la suppression des images car je travaille dorénavant un groupe d'image.
Pas de soucis pour l'afficher mais en revanche, j'aimerai connaitre l'équivalent du code ci dessous pour un groupe d'image.

Il me semble que la correspondance pour msoPicture est msoPictureGroup mais concernant .shapes ?
Ci dessous le code de Mercatog publié plus haut.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub DeletDuplicatedShapes()
Dim Shp As Shape
Dim c As Integer

With Worksheets("Feuil2")
    For Each Shp In .Shapes
        If Shp.Type = msoPictureGroup Then
            c = c + 1
            If c > 1 Then Shp.Delete
        End If
    Next Shp
End With
MsgBox c - 1 & " image(s) supprimée(s)"
End Sub

Merci pour votre aide

Afficher x images selon x [XL-MAC 2011]

Macros et VBA Excel

Discussions similaires

Partager

Partager