XL 2010 [RÉSOLUE]Centrer une image dans une cellule

Toubabou

XLDnaute Impliqué
Bonjour à tous,
LE code suivant permets d'envoyer plusieurs informations sur une page d'impression, "Image3" en autre. Pourriez-vous m'aider afin que cette "Image3" centre l'image dans le haut de sa cellule de destination, soit la cellule" B4"
VB:
Private Sub CommandButton5_Click()    'Envoi feuille Impression
    Dim S As Shape, Tablo, I&
    Application.ScreenUpdating = False
    Sheets("IMPRESSION").Visible = 1
    Sheets("IMPRESSION").Select
    For Each S In ActiveSheet.Shapes
        If Not Intersect(S.TopLeftCell, [A1:B4]) Is Nothing Then S.Delete
    Next
    [b16:B400].ClearContents
      
         [a5] = Label13: [b5] = Label7
         [a7] = Label5: [b7] = Label8
         [a9] = Label6: [b9] = Label10
         [a11] = Label11: [b11] = Label9
         [a13] = Label12: [a15] = Label3
         [B15] = Label4:
        
    [A1] = ComboBox1: [b1] = ComboBox2
    [A6] = Textbox2: [B6] = Textbox4
    [A8] = Textbox1: [B8] = Textbox5
    [A10] = Textbox3: [B10] = TextBox8
    [A12] = TextBox9: [B12] = TextBox11
    [A14] = TextBox10: [A16] = TextBox6
    Tablo = Split(TextBox7.Text, Chr(10))
    For I = LBound(Tablo) To UBound(Tablo)
        Cells(I + 16, 2) = Trim(Replace(Tablo(I), Chr(10), ""))
    Next I
    Rows("16:400").EntireRow.AutoFit
    Call InsImage(Image1.Tag, [A4], 1)
    Call InsImage(Image2.Tag, [B4], 2)

    If Image3.Tag = "" Then OptionButton5 = True    'lance OptionButton_Click
    Call InsImage(Image3.Tag, [B4], 3)
    'If CheckBox1.Value = True Then
    '   ActiveSheet.Shapes("Image3").Visible = True
    'Else
    '   ActiveSheet.Shapes("Image3").Visible = False
    'End If
    Application.Goto [A1], True
    '  [A1].Activate
    Unload Me
End Sub

Merci par avance,
Toubabou
 

job75

XLDnaute Barbatruc
Bonjour Toubabou, JM,

Je veux bien aider mais je n'ai pas compris quelle macro il faut corriger (la macro InsImage n'est pas de moi).

Ni sur quel bouton il faut cliquer pour la lancer.

Par ailleurs il est tout à fait aberrant que les onglets ne soient pas affichés !!!

A+
 

Staple1600

XLDnaute Barbatruc
Bonsoir job75

Si j'en crois le moteur de recherche du forum, il semble bien pourtant que tu as déjà été en contact avec cette procédure, non ? ;) (à partir du post#7 dans le fil ci-dessous)

Toubabou
Si tu pouvais joindre un fichier moins volumineux et recentré sur ta problématique
(Un seul userform en lien avec ton CommandButton5_Click et tout ce qui s'y rattache)
 
Dernière édition:

Toubabou

XLDnaute Impliqué
Bonsoir job75

Si j'en crois le moteur de recherche du forum, il semble bien pourtant que tu as déjà été en contact avec cette procédure, non ? ;)
www.excel-downloads.com

Toubabou
Si tu pouvais joindre un fichier moins volumineux et recentré sur ta problématique
(Un seul userform en lien avec ton CommandButton5_Click et tout ce qui s'y rattache)
Bonsoir à vous deux,
Je vous réponds dès que je sors de mes cours de mycologie.
Merci à vous deux .
Jean-Marie
 

Toubabou

XLDnaute Impliqué
Bonjour à vous deux, bonjour le forum,
Voilà, j'ai épuré mon fichier.
Alors pour mémoire, à l'ouverture de mon fichier on clique sur recette, on sélectionne le "Type de recette", puis "Sélection de la recette".
La recette s'affiche.
en cliquant sur "Imprimer", une feuille pour impression s'affiche. Tout fonctionne correctement bien jusque là.
Mon seul soucis est que l'image se trouvant en "B4" n'est pas centrée à la cellule. J'aurais aimé qu'elle soit centrée en haut de la cellule.
Je vous remercie par avance et vous prie de m'excuser si je vous ai froissé. Ce n'était pas du tout mon intention. A vouloir faire trop correct, il m'arrive de faire des bourdes.
Jean-Marie
 

Pièces jointes

  • Recettes Correction.xlsm
    280.9 KB · Affichages: 6

job75

XLDnaute Barbatruc
Il suffisait de remonter de 2 lignes l'instruction .Height = 100 utilisez donc :
VB:
Private Sub InsImage(Image$, Cel As Range, ordre As Byte)
    If ComboBox2.ListIndex = -1 Then
        If ordre = 1 Then MsgBox "La recette n'a pas été sélectionnée..."
        Exit Sub
    End If
    Static Y    'mémorise
    Cel.Activate
    Cel = Image
    With Sheets("IMPRESSION").Pictures.Insert(Image)
        .ShapeRange.LockAspectRatio = msoTrue
        If ordre = 1 Then
            .Height = Cel.Height * 0.9
            If .Width > Cel.Width * 0.9 Then .Width = Cel.Width * 0.9
            .Top = Cel.Top + (Cel.Height - .Height) / 2
            .Left = Cel.Left + (Cel.Width - .Width) / 2
            Y = .Top
        ElseIf ordre = 2 Then
            .Top = Y + 120
            If .Width > Cel.Width Then .Width = Cel.Width
            .Left = Cel.Left + (Cel.Width - .Width) / 2
        ElseIf ordre = 3 Then
            .Top = Y
            .Height = 100
            .Left = Cel.Left + (Cel.Width - .Width) / 2
        End If
    End With
End Sub
Par ailleurs ACCEUIL fait mal aux yeux, vérifiez l'orthographe SVP...

A+
 

Toubabou

XLDnaute Impliqué
Bonsoir JOB75, Staple1600, bonsoir à tous
Je viens de faire la modification dans mon code , super cela fonctionne magnifiquement bien. J'ai également rectifier "ACCUEIL", je n'avais pas fait attention, merci pour l'information.
Un grand merci à vous deux.
bonne fin de journée
Jean-Marie
 

Discussions similaires

Réponses
7
Affichages
647

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 837
dernier inscrit
Ugo