Inserer une image dans plusieurs cellules

Résolu
rickquo -  
Nepyim Messages postés 7 Statut Membre -
Bonjour,
voila mon souci :
je voudrai importer une image,la redimensionner a la taille de plusieurs cellules excel fusionné.
j'ai réussi avec une macro mais celle ci adapte l'image qu'a une seul cellule.

merci d'avance

Sub Macro1()
Public Sub insere_image()
Dim ficimg As Variant
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Top = ActiveCell.Top ' haut de la cellule
.Left = ActiveCell.Left ' gauche de la cellule
.Height = ActiveCell.RowHeight ' hauteur de la cellule
.Width = ActiveCell.Width ' largeur de la cellule
End With
With Selection
.PrintObject = True ' l'objet est imprimé en même temps que le document
.Placement = xlMoveAndSize ' manière dont l'objet est lié aux cellules
End With
End Sub

10 réponses

  1. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour,
    Tu doit employé la plage complète des cellules fusionnées plutôt que la cellule de référence.
    Par exemple Height = Range("A1:B3")
    A+
    0
  2. rickquo
     
    Bonjour,
    merci Lermite222,
    mon souci c'est que je voudrai que l'image s'insère sur des cellules différente que je sélectionne.
    a+
    0
  3. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Beh moi j'ai lu ... de plusieurs cellules excel fusionné
    maintenant la solution est la même tu prend la hauteur de la sélection
    a$ = Selection.Address
    h = Range(a$).Height

    A+
    Edit;
    Par acquit de conscience j'ai tester et tu peu simplifier par
    h = Selection.Height
    0
  4. rickquo
     
    Bonjour,
    merci Lermite222,
    oui tu as raison j'ai formulé ma question d'une façon et répondu d'une autre,mais l'idée est bien d'avoir des cellules fusionnés a des endroits différent de ma feuilles.
    je vais essayer tout ça demain.
    merci encore.
    a+
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. rickquo
     
    Bonjour,
    merci Lermite222,
    bon ben j'ai essayé avec Height = Range("A1:B3") à la place de .Height = ActiveCell.RowHeight mais il me colle l'image trop grande en largeur et en hauteur,
    ensuite j'ai remplacer.Height = ActiveCell.RowHeight par .Height = Selection.Height la il respecte le largeur de la colonne mais pas la hauteur des cellules fusionner.
    y a t'il un réglage dans excel pour que les image garde une hauteur paramètre ?
    ou je me suis planté quelque part ?
    merci d'avance.
    0
  7. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    je lit... la redimensionner a la taille de plusieurs cellules excel fusionné
    C'est l'image que tu doit redimentionner et pas les cellules... -:))

    0
  8. rickquo
     
    Bonjour,
    Oui c'est ce que j essaye de faire mais je ne sai pas ou je doit inssére la ligne h = Selection.Height
    merci.
    0
  9. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    With Selection.ShapeRange
    .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
    .Top = Selection.Top ' haut de la cellule
    .Left = Selection.Left ' gauche de la cellule
    .Height = Selection.Height ' hauteur de la cellule
    .Width = Selection.Width ' largeur de la cellule
    End With
    Tu dit...
    A+
    0
    1. rickquo
       
      Bonjour Lermite222,
      ben je dit un grand merci.
      A+
      0
      1. Nepyim Messages postés 7 Statut Membre > rickquo
         
        Bonjour,

        j'ai lu avec beaucoup d'intérêt cette discussion parce que je veux faire de même (enfin c'est ce que je croyais parce que je n'y parviens pas). Je précise :

        Je veux insérer une image en la recherchant par arborescence (comme c'est le cas) et l'insérer dans une cellule qui est en fait la fusion de plusieurs cellules.

        Cette petite différence est peut-être significative parce que je ne parviens pas à l'insérer aux dimensions de la 'cellule fusionnée'.

        merci d'avance
        0
  10. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour,
    Qu'est-ce que tu ne parvient pas à faire ?
    Pour rappel c'est en VBA, tu doit donc faire une macro
    A+
    0
    1. Nepyim Messages postés 7 Statut Membre
       
      De la discussion précédente, voici ce que j'ai essayé :


      Public Sub insere_image()
      Dim ficimg As Variant
      ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
      ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
      With Selection.ShapeRange
      .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
      .Top = ActiveCell.Top ' haut de la cellule
      .Left = ActiveCell.Left ' gauche de la cellule
      .Height = ActiveCell.RowHeight ' hauteur de la cellule
      .Width = ActiveCell.Width ' largeur de la cellule
      End With
      With Selection
      .PrintObject = True ' l'objet est imprimé en même temps que le document
      .Placement = xlMoveAndSize ' manière dont l'objet est lié aux cellules
      End With
      End Sub


      Public Sub insere_image2()
      Dim ficimg As Variant
      ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
      ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
      With Selection.ShapeRange
      .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
      .Top = Selection.Top ' haut de la cellule
      .Left = Selection.Left ' gauche de la cellule
      .Height = Selection.Height ' hauteur de la cellule
      .Width = Selection.Width ' largeur de la cellule
      End With
      With Selection
      .PrintObject = True ' l'objet est imprimé en même temps que le document
      .Placement = xlMoveAndSize ' manière dont l'objet est lié aux cellules
      End With
      End Sub


      Je rappelle que lorsque je teste ces macros, j'ai auparavant sélectionné une cellule qui est la fusion de 2 cellules (par exemple (A2:B2)), et que c'est à cette fusion que je souhaite ajuster mon image chargée.

      Si je lance la macro 'insere_image' : le chargement de l'image se fait correctement mais cette image ne s'ajuste qu' à une seule des 2 cellules fusionnées (en l'occurence A2)

      Si je lance la macro 'insere_image2' : le chargement de l'image se fait correctement mais cette image ne s'ajuste pas du tout et apparait en taille 100%.

      Je ne dois pas être bien loin mais je coince. Merci d'avance pour vos lumières.
      0
  11. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Re,
    Effctivement tu n'en est pas loin...
    Sub insere_image2()
    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+
    0
    1. Nepyim Messages postés 7 Statut Membre
       
      Merci beaucoup pour ces informations : c'est exactement ce que je cherchais... et je ne parvenais pas à définir la zone de sélection.

      Merci mille fois, ça fait super plaisir de rencontrer des personnes qui ne sont a priori pas concernées par mon problème mais qui mettent de l'énergie et de l'enthousiasme à m'aider.

      Merci encore

      Nepyim
      0