High-Tech Santé Médecine Droit-Finances

Grippe A

Que dois-je faire ?

Rechercher : dans
Par :

EXCEL : insertion et paramétrage d'une image

Dernière réponse le 3 déc 2008 à 09:51:35 Nepyim, le 2 déc 2008 à 09:21:28 
 Signaler ce message aux modérateurs

Bonjour,

Je cherche à insérer une image dans une cellule fusionnée. J’ai lu beaucoup de discussions sur le sujet et j’en tiré la macro suivante :

Sub insere_image()
Dim ficimg As String, Ad As String
Ad = Selection.Address
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
If ficimg = "Faux" Then Exit Sub
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
'Pas besoin, c'est fait automatiquement sur la sélection :
'.Top = Range(Ad).Top ' haut de la cellule
'.Left = Range(Ad).Left ' gauche de la cellule
.Height = Range(Ad).Height ' hauteur des cellules fusionnées
.Width = Range(Ad).Width ' largeur des cellules fusionnées
End With
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
End Sub


Ça marche plutôt bien mais j’ai quelques souhaits complémentaires que je ne parviens pas à résoudre :
1/ je souhaite que l’image garde ses proportions d’origine (là, ça devrait aller)
2/ je souhaite que la taille de l’image soit ajustée à la taille de la cellule fusionnée en fonction de sa plus grande dimension. (C’est-à-dire : étirer l’image jusqu’à ce que sa hauteur corresponde à la hauteur de la cellule ou étirer l’image jusqu’à ce que sa largeur corresponde à la largeur de la cellule)
3/ je souhaite que sur l’autre dimension (que celle ajustée à la cellule) soit centrée sur la cellule

Merci d’avance pour vos bons conseils

Configuration: Windows XP
Internet Explorer 6.0

Meilleures réponses pour « EXCEL : insertion et paramétrage d'une image » dans :
Insérer une image dans un mail Gmail en cours de composition VoirVoici une excellente méthode pour insérer des images dans vos e-mails Gmail. Résultat garanti ! Vu que vous avez un compte Gmail (puisque vous vous posez cette question) vous avez nécessairement accès à Google Documents. C'est le même compte...
[CCM] Insérer une image dans une discussion VoirLes forums de CCM ne contiennent volontairement pas la possibilité d'insérer des images dans les messages afin de garder une certaine cohérence aux forums. Cependant, il vous est possible de montrer des images ou des captures d'écran en...
[CommentçaMarche] Insérer une image dans la FAQ VoirPour insérer une image dans une FAQ Insérer des captures d'écran peut aider à la compréhension d'une explication. Voici comment procéder pour améliorer les Astuces de CommentçaMarche (les FAQ). Il y a deux manière d'insérer une image: Soit une...
LaTeX - Insertion d'images VoirStyle LaTeX permet d'insérer des images de différents formats. Le plus simple est d'insérer des fichiers de type eps (Encapsuled Postscript) : Il suffit d'insérer dans le préambule la ligne suivante : \usepackage{graphicx} Puis d'insérer...
Les arrière-plans VoirInsérer une image en fond Il est possible de définir une image d'arrière-plan pour la page web grâce aux attributs de la balise  : Attribut Effet Visuel BACKGROUND="image" Affiche l'image en arrière...
Posez votre question Répondre

1

lermite222, le 2 déc 2008 à 12:01:54

Bonjour,
Si j'ai bien compris, j'ai modifié mon code pour garder le ratio dans toutes les circonstances, c'est un peu plus compliqué. 

Sub insere_image_ratio()
Dim ficimg As String, Ad As String
Dim MemW As Long, MemH As Long, T As Integer, L As Integer
Dim Lg As Integer, HT As Integer, RatioCell As Single
Dim CellH As Long, CellW As Long, RatioHz As Single, RatioVt As Single
    Ad = Selection.Address
    CellH = Selection.Height
    CellW = Selection.Width
    ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
    If ficimg = "Faux" Then Exit Sub
    ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
    With Selection.ShapeRange
        MemW = .Width: MemH = .Height
        'adapte les ratio
        If MemH < CellH And MemW < CellW Then
        'l'image < cellule
            RatioHz = MemH / CellH
            RatioVt = MemW / CellW
            If RatioVt < RatioHz Then 'adapter en hauteur
                HT = CellH:  Lg = MemW * (HT / MemH)
                T = 0: L = (CellW - Lg) / 2
            Else 'adapter en largeur
                Lg = CellW: HT = MemH * (CellW / MemW)
                L = 0: T = (CellH - HT) / 2
            End If
        ElseIf MemH > CellH And MemW > CellW Then
        'l'image > cellule
            RatioHz = CellH / MemH
            RatioVt = CellW / MemW
            If RatioVt > RatioHz Then 'adapter en hauteur
                HT = CellH:  Lg = MemW * (HT / MemH)
                T = 0: L = (CellW - Lg) / 2
            Else 'adapter en largeur
                Lg = CellW: HT = MemH * (Lg / MemW)
                L = 0: T = (CellH - HT) / 2
            End If
        ElseIf MemH > CellH And MemW < CellW Then
        'adapter en hauteur
            HT = CellH:  Lg = MemW * (HT / MemH)
            T = 0: L = (CellW - Lg) / 2
        ElseIf MemH < CellH And MemW > CellW Then
        'adapter en largeur
            Lg = CellW: HT = MemH * (Lg / MemW)
            L = 0: T = (CellH - HT) / 2
        Else
            Stop ' pas prévu ?
        End If
        
        .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
        .Top = Range(Ad).Top + T ' haut de la cellule
        .Left = Range(Ad).Left + L ' gauche de la cellule
        .Height = HT
        .Width = Lg ' largeur des cellules fusionnées
    End With
    With Selection
        .Placement = xlMoveAndSize
        .PrintObject = True
    End With
End Sub

tu dit...
A+ L'expérience instruit plus sûrement que le conseil. (André Gide)  
Si tu te cogne à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)

   
Répondre à lermite222

2

 Nepyim, le 3 déc 2008 à 09:51:35

Formidable !

j'ai testé et ça a marché pile poil comme je le souhaitais.
Je n'ai pas trop regardé le code pour le moment (le copier-coller ça a du bon) mais j'y ai vu ce que je pensais, à savoir le calcul sur les dimensions d'image et dimensions de cellule afin d'ajuster le tout... J'avais un peu pensé à cette méthode sans l'avoir encore testée parce que j'osais espérer qu'il existait une fonction du genre 'centrer' ou 'ajuster'.

En tous cas, merci beaucoup pour cette aide aussi fructueuse que rapide!

A bientôt peut-être

   
Répondre à Nepyim
Posez votre question Répondre
Ils ont besoin de votre aide
Collection CommentÇaMarche.net