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

Toubabou

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

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Toubabou
1) Il manque la macro InsImage
2) Depuis le temps (4/12/2014) , tu devrais savoir que c'est plus simple quand le demandeur joint un fichier exemple ;)
 

Staple1600

XLDnaute Barbatruc
Re

On ne joint jamais le fichier original, mais une copie simplifiée illustrant le problème ;)
Du coup, j'ai pondu ceci (sans ton fichier)
Donc je publie et te laisse faire les adaptations nécessaires
VB:
Private Sub Ajuster_SHP(rng As Range, shpNom$)
Dim shp As Shape: Set shp = ActiveSheet.Shapes(shpNom)
With shp
.Top = rng.Top: .Left = rng.Left
.Width = rng.Width: .Height = rng.Height
End With
End Sub

Sub test()
Ajuster_SHP Range("B4"), "TOTO"
End Sub
Ici dans cet exemple, j'utilise une forme* nommée TOTO
(*: shape)
 

Toubabou

XLDnaute Occasionnel
Re

On ne joint jamais le fichier original, mais une copie simplifiée illustrant le problème ;)
Du coup, j'ai pondu ceci (sans ton fichier)
Donc je publie et te laisse faire les adaptations nécessaires
VB:
Private Sub Ajuster_SHP(rng As Range, shpNom$)
Dim shp As Shape: Set shp = ActiveSheet.Shapes(shpNom)
With shp
.Top = rng.Top: .Left = rng.Left
.Width = rng.Width: .Height = rng.Height
End With
End Sub

Sub test()
Ajuster_SHP Range("B4"), "TOTO"
End Sub
Ici dans cet exemple, j'utilise une forme* nommée TOTO
(*: shape)
Merci beaucoup, si j'ai bien compris, je doit remplacé "TOTO" par "Image3"?
 

Staple1600

XLDnaute Barbatruc
Re

Avec celle-ci?
Cette-fois-ci la macro centre la première "shape" sur la feuille active
VB:
Sub Test2()
Centrer_SHP ActiveSheet.Shapes(1), Range("B4")
End Sub

Private Sub Centrer_SHP(Shp As Shape, r As Range)
With Shp
.Left = r.Left + ((r.Width - .Width) / 2)
.Top = r.Top + ((r.Height - .Height) / 2)
End With
End Sub
 

Toubabou

XLDnaute Occasionnel
Re

Avec celle-ci?
Cette-fois-ci la macro centre la première "shape" sur la feuille active
VB:
Sub Test2()
Centrer_SHP ActiveSheet.Shapes(1), Range("B4")
End Sub

Private Sub Centrer_SHP(Shp As Shape, r As Range)
With Shp
.Left = r.Left + ((r.Width - .Width) / 2)
.Top = r.Top + ((r.Height - .Height) / 2)
End With
End Sub
Toujours pas, mais j'avoue que je ne suis toujours pas doué en VBA
Jean-Marie M
 

Staple1600

XLDnaute Barbatruc
Re

Chez moi, cela fonctionne
Sur ma feuille active, j'ai deux formes (Shape) et une image (Picture)
Donc si je lance les deux macros l'une après l'autre, l'image s'adapte à la taille de la cellule puis se centre en D9
VB:
Sub Test3()
Ajuster_SHP Range("D9"), "Image 3"
Centrer_SHP ActiveSheet.Shapes(3), Range("D9")
End Sub
Private Sub Ajuster_SHP(rng As Range, shpNom$)
Dim Shp As Shape: Set Shp = ActiveSheet.Shapes(shpNom)
With Shp
.Top = rng.Top: .Left = rng.Left
.Width = rng.Width: .Height = rng.Height
End With
End Sub
Private Sub Centrer_SHP(Shp As Shape, r As Range)
With Shp
.Left = r.Left + ((r.Width - .Width) / 2)
.Top = r.Top + ((r.Height - .Height) / 2)
End With
End Sub
Voir copie d'écran ci-dessous
01Tobabou.JPG
 

Toubabou

XLDnaute Occasionnel
Re

Chez moi, cela fonctionne
Sur ma feuille active, j'ai deux formes (Shape) et une image (Picture)
Donc si je lance les deux macros l'une après l'autre, l'image s'adapte à la taille de la cellule puis se centre en D9
VB:
Sub Test3()
Ajuster_SHP Range("D9"), "Image 3"
Centrer_SHP ActiveSheet.Shapes(3), Range("D9")
End Sub
Private Sub Ajuster_SHP(rng As Range, shpNom$)
Dim Shp As Shape: Set Shp = ActiveSheet.Shapes(shpNom)
With Shp
.Top = rng.Top: .Left = rng.Left
.Width = rng.Width: .Height = rng.Height
End With
End Sub
Private Sub Centrer_SHP(Shp As Shape, r As Range)
With Shp
.Left = r.Left + ((r.Width - .Width) / 2)
.Top = r.Top + ((r.Height - .Height) / 2)
End With
End Sub
Voir copie d'écran ci-dessous
Voir la pièce jointe 1030279
Désolé JM, cela ne fonctionne pas dans mon fichier, ce n'est pas grave et je suis convaincu que c'est moi qui n'est résolument pas doué.
Je te prie de bien vouloir m'excuser de t'avoir pris du temps inutilement. Merci tout de même.
Jean-Marie M...
 

Staple1600

XLDnaute Barbatruc
Re

NB: Je suis connecté sur XLD de mon plein gré.
Et si je te réponds c'est que je suis disponible ;)

Essaies sur un classeur vierge (comme sur mon exemple, deux formes automatiques et une image nommé Image 3)
Normalement tu dois obtenir le même résultat.

Sinon d'autres viendront t'aider ;)

Pour le moment, je m'en vais regarder Pandorum.

Je repasserai plus tard.
 

Staple1600

XLDnaute Barbatruc
Re,


Donc j'ai ouvert ton fichier
(que tu devrais anonymiser cf la photo de l'Userform1 entre autres chose)
Et j'ai bien vu la macro
VB:
Private Sub InsImage(Image$, Cel As Range, ordre As Byte)
    Static Y    'mémorise
    Cel.Activate
    Cel = Image
    With Sheets("IMPRESSION").Pictures.Insert(Image)
        '.Name = 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
            .Left = Cel.Left + ((Cel.Width - .Width) / 2)
            
        ElseIf ordre = 3 Then
            .Top = Y
            .Left = Cel.Left + ((Cel.Width - .Width) / 2)
            .Height = 100
        Else
            .Top = Y + 120
        End If
    End With
End Sub
Maintenant, pourquoi ne pas avoir laissé le commentaire lors de ton copier/coller dans le fil?
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''Macro faite par JOB75 le 02/10/2018, affiche automatiuement l'image de OptionButton4 en cas de non sélection d'un OptionButton''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Je laisse donc la main à job75 si il repasse par ici

Et je retourne voir mon film ;)
 

Toubabou

XLDnaute Occasionnel
Re,


Donc j'ai ouvert ton fichier
(que tu devrais anonymiser cf la photo de l'Userform1 entre autres chose)
Et j'ai bien vu la macro
VB:
Private Sub InsImage(Image$, Cel As Range, ordre As Byte)
    Static Y    'mémorise
    Cel.Activate
    Cel = Image
    With Sheets("IMPRESSION").Pictures.Insert(Image)
        '.Name = 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
            .Left = Cel.Left + ((Cel.Width - .Width) / 2)
           
        ElseIf ordre = 3 Then
            .Top = Y
            .Left = Cel.Left + ((Cel.Width - .Width) / 2)
            .Height = 100
        Else
            .Top = Y + 120
        End If
    End With
End Sub
Maintenant, pourquoi ne pas avoir laissé le commentaire lors de ton copier/coller dans le fil?
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''Macro faite par JOB75 le 02/10/2018, affiche automatiuement l'image de OptionButton4 en cas de non sélection d'un OptionButton''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Je laisse donc la main à job75 si il repasse par ici

Et je retourne voir mon film ;)
Je n'ai pas laissé le commentaire parce-que je pensais que c'était personnel. Je m'excuse si j'ai froissé quelqu'un, surtout JOB75, ce n'étais pas mon intention.
Jean-Marie
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Aie, petit quiproquo détécté ;)
Donc je passe en Option Explicit pour le lever illico presto.
Je voulais juste dire qu'en laissant le commentaire indiquant l'auteur du code, ou en indiquant dans ton 1er message, un truc du genre
"J'ai un souci avec cette macro de Job75 que je n'arrive pas à adapter"
Bah, en lisant ton message avec cette info en plus, on se dit qu'il y a de fortes chances que lisant cela Job75 viendra te filer un coup de main.

Donc nulle froissement dans ta discussion, et désolé pour le quiproquo.
 

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

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour Toubabou, JM,

Je ne vois vraiment pas ce qui pourrait froisser mais bon.

Par contre en cliquant sur le bouton IMPRIMER j'ai eu un message d'erreur, ça c'est gonflant, j'ai vite quitté.

A+
 

Discussions similaires


Haut Bas