Création forme rectangulaire avec contenu texte / Macro

Bonjour à tous et toutes !

Je viens à vous avec très peu d'info et sans fichier excel pour le moment car je ne sais pas trop par où commencer ma programmation.

Au l'appui d'un bouton de commande je souhaiterais créer une vignette comme ci-dessous. Cependant il va y avoir plusieurs spécificités que je ne sais pas comment gérer :

- Tous les champs " XXXX" sont des champs fixes qui seront les mêmes pour toute les vignettes.

- Les champs "11111" seront à remplir dans le Userform et vont de se mettre directement

- Les champs " 2222" pourront être remplis en suivant directement sur l'excel

- J'aimerais qu'à sa création, la vignette soit "réduite" en hauteur (Au niveau du trait rouge), avec l'ajout d'un petit bouton macro qui permet de l'agrandir pour tout afficher.

- En plus de ca, j'aimerais ajouter sur cette même forme, une case que je coche pour changer la couleur de la vignette

C'est très global mais rien qu'un début d'ébauche pourrait m'aider à démarrer :)

Merci d'avance pour votre aide :)

Bonne journée à tous !

Cdlt,

Bonjour,

Vous pourriez créer vos vignettes via un objet ChartObject :

Option Explicit

Sub CreationVignette()

Dim ShDonnees As Worksheet
Dim ShChObj As ChartObject
Dim AireImage As Range
Dim MaForme As Shape
Dim MonChemin As String, LaCouleur As String

    MonChemin = ThisWorkbook.Path
    Set ShDonnees = Sheets("Données")

    With ShDonnees

         Select Case Range("SelectionCouleur")
                Case "Verte"
                      Range("EtiquetteForme2").Interior.Color = RGB(235, 241, 222)
                Case "Jaune"
                      Range("EtiquetteForme2").Interior.Color = RGB(255, 255, 0)
         End Select

         Select Case Range("SelectionVignette")
                Case "Réduite"
                      Set AireImage = .Range("EtiquetteForme1")
                Case "Entière"
                      Set AireImage = .Range("EtiquetteForme2")
        End Select

        Set ShChObj = .ChartObjects.Add(.Range("G10").Left, .Range("G10").Top, AireImage.Width, AireImage.Height)

        AireImage.CopyPicture xlScreen, xlBitmap

        Application.DisplayAlerts = False
        With ShChObj
             .Chart.ChartArea.Select
             .Chart.Paste
           '  .Chart.Export MonChemin & "AireImage1.Jpg"
           '  .Delete
        End With
        Application.DisplayAlerts = True

    End With

    Set ShDonnees = Nothing

End Sub