Discussion :

[Grim's Art Design]

Bonjour a tous,

Je débute avec le VBA et je suis embêter avec un fichier Excel.
j'utilise un tableau de saisi pour récolter les données et lors d'un double clic dans une cases précise, je souhaite crée une fiche de synthèse.
En ce qui concerne le double clic et les données écrite, pas de soucis! mais je cherche à insérer dans cette fiche de synthèse plusieurs image c'est a ce moment que cela ce gâte!!!
Pour une pas de problème! mais je n'arrive pas à en insérer plusieurs!!!

En effet dans mon tableau de saisi j'ai des cases rempli par du texte et dans les colonnes F, G, H et bien d’autres, je souhaite mettre le nom d’une image ((xxx.jpg) qui bien sûr ne serait peut-être pas les mêmes sur chaque lignes) que j’aurais au préalable stocké dans un dossier « Photos ».

Lors du double clic le texte et les images iront ce mettre dans d’autre cases correspondant à leur emplacement dans la fiche de synthèse.

Ma macro fonctionne très bien pour le texte et 1 image mais je n’arrive pas à la modifié pour plusieurs images.

Est ce qu'une âme charitable pourrais me données des pistes pour que je puisse le faire ou modifié le code déjà existant.
je joint le fichier source.

par avance merci de votre aide.

bonne fête de fin d'années à tous

[EricDgn]

Bonjour,

Une façon de faire est de prévoir une petite routine pour insérer une image, sans oublier qu'il faut effacer celles placées auparavant:

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
28
29
30
31
32
33
34
35
36
37
Option Explicit
 
Sub EffacerImages(sWsh As String)
    '--- sWsh: nom de la feuille à traiter
    Dim sh As Shape
    For Each sh In Worksheets(sWsh).Shapes
        Debug.Print sh.Name, sh.Type
        If sh.Type = 13 Or sh.Type = 11 Then
            sh.Delete
        End If
    Next sh
End Sub
 
Sub PlacerImage(sFile As String, sWsh As String, sC As String)
    '--- sFile: nom du fichier image
    '--- sWsh: nom de la feuille destination
    '--- sC: adresse cellule destination
    Dim chemin As String
    If sFile <> "" Then
        sFile = ThisWorkbook.Path + "\Photos\" & sFile
        If Dir(sFile) = "" Then
            MsgBox "Fichier " & sFile & " non trouvé!", vbExclamation, "Anomalie"
        Else
            With Worksheets(sWsh).Pictures.Insert(sFile)
                With .ShapeRange
                    .LockAspectRatio = msoTrue
                    .Width = 76
                    .Height = 76
                End With
                .Left = Worksheets(sWsh).Range(sC).Left
                .Top = Worksheets(sWsh).Range(sC).Top
                .Placement = 1
                .PrintObject = True
            End With
        End If
    End If
End Sub

Cordialement.

[yalehaire]

Bonjour
Une autre proposition