[XL-2010] Ajouter image dans cellule avec x copie

Bonsoir au forum,

Je souhaite effectuer une copie d'un texte provenant de Textbox et ComboBox et le multiplier un certain nombre de fois. Pour le moment ça va mais je souhaite y adjoindre une image "Image1" dans la copie !

Voici le code pour la copie de texte

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
Dim PDepart As String, Validite As String
Dim TextEtiquette As String, PremLig As String, SecLig As String, TrLig As String
Dim Indice As Integer, I As Integer
Dim Ctl As Control
 
  PDepart = Me.CBoxColonne & Me.CBoxLigne
  PremLig = CBoxProduit & " - " & CBoxMarque & Chr(10)
  SecLig = "Mise en conditionnement le : " & TxtBoxDate & Chr(10)
  TrLig = "A consommer avant le " & TxtBoxDLC
 
  TextEtiquette = PremLig & SecLig & TrLig
 
  With Sheets(NomFeuille)
 
    If Me.OptButtonH = True Then        ' Mode horizontal
      Indice = ((.Range(PDepart).Row - 1) * NombreColonne) + .Range(PDepart).Column - 1
    Else                                ' Mode vertical
      Indice = (.Range(PDepart).Row - 1) + (.Range(PDepart).Column - 1) * NombreLigne
    End If
 
    If Indice + Val(Me.CBoxNombre) > NombreMaxiEtiquettes Then
      MsgBox "Impossible de copier " & Me.CBoxNombre & " étiquettes" & vbCr & vbCr & vbCr & _
             " Au maximum possibilité de créer " & 1 + NombreMaxiEtiquettes - Indice & " étiquettes" & vbCr & vbCr, vbInformation
      Exit Sub
    End If
 
    With .Range(PDepart)
      .Value = TextEtiquette
      .Characters(Start:=1, Length:=Len(PremLig)).Font.Bold = True
      .Characters(Start:=Len(PremLig) + Len(SecLig), Length:=Len(TrLig)).Font.Italic = True
    End With
 
    For I = 1 To Val(Me.CBoxNombre) - 1
      Indice = Indice + 1
      If Me.OptButtonH = True Then        ' Mode horizontal
        .Range(PDepart).Copy Destination:=.Cells(1 + (Indice \ NombreColonne), 1 + (Indice Mod NombreColonne))
      Else                                ' Mode vertical
        .Range(PDepart).Copy Destination:=.Cells(1 + (Indice Mod NombreLigne), 1 + (Indice \ NombreLigne))
      End If
    Next I
  End With

Comment faire pour copier aussi l'image du Control "Image1" à droite de la cellule sans cacher le texte (prédéfinir format par exemple)?

Merci

Stephanie