Discussion :

[stephadm]

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 :

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
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

[stephadm]

bonjour au forum,

La réponse pour ceux qui seront intéressés

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
...
   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
 
      Haut = .Top
      Gauche = .Left + (.Width / 2)
      Largeur = .Width / 2
      Hauteur = .Height
 
    End With
 
    If Image = True Then
      With .Pictures.Insert(Me.TxtBoxDossier & "\" & Me.LstBoxImages).ShapeRange   ' On insère l'image
        .LockAspectRatio = msoFalse                       ' On peut la redimmensionner comme on veut
        .Left = Gauche                                    ' Position gauche
        .Top = Haut                                       ' Position Haut
        .Width = Largeur                                  ' Largeur
        .Height = Hauteur                                 ' hauteur
      End With
    End If
...

moi même ayant galéré et trouvé beaucoup de soutient sur ce forum

Merci

Stephanie