Inserer une image dans plusieurs cellules

Résolu/Fermé
rickquo Messages postés 6 Date d'inscription samedi 8 novembre 2008 Statut Membre Dernière intervention 11 novembre 2008 - 8 nov. 2008 à 18:19
Nepyim Messages postés 7 Date d'inscription samedi 22 novembre 2003 Statut Membre Dernière intervention 3 décembre 2008 - 28 nov. 2008 à 15:55
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
A voir également:

10 réponses

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
8 nov. 2008 à 18:37
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
rickquo Messages postés 6 Date d'inscription samedi 8 novembre 2008 Statut Membre Dernière intervention 11 novembre 2008
8 nov. 2008 à 23:50
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
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
9 nov. 2008 à 00:13
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
rickquo Messages postés 6 Date d'inscription samedi 8 novembre 2008 Statut Membre Dernière intervention 11 novembre 2008
9 nov. 2008 à 19:48
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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
rickquo Messages postés 6 Date d'inscription samedi 8 novembre 2008 Statut Membre Dernière intervention 11 novembre 2008
10 nov. 2008 à 14:50
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
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
10 nov. 2008 à 17:14
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
rickquo Messages postés 6 Date d'inscription samedi 8 novembre 2008 Statut Membre Dernière intervention 11 novembre 2008
10 nov. 2008 à 18:05
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
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
10 nov. 2008 à 18:15
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
rickquo Messages postés 6 Date d'inscription samedi 8 novembre 2008 Statut Membre Dernière intervention 11 novembre 2008
11 nov. 2008 à 11:07
Bonjour Lermite222,
ben je dit un grand merci.
A+
0
Nepyim Messages postés 7 Date d'inscription samedi 22 novembre 2003 Statut Membre Dernière intervention 3 décembre 2008 > rickquo Messages postés 6 Date d'inscription samedi 8 novembre 2008 Statut Membre Dernière intervention 11 novembre 2008
25 nov. 2008 à 18:57
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
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
26 nov. 2008 à 11:10
Bonjour,
Qu'est-ce que tu ne parvient pas à faire ?
Pour rappel c'est en VBA, tu doit donc faire une macro
A+
0
Nepyim Messages postés 7 Date d'inscription samedi 22 novembre 2003 Statut Membre Dernière intervention 3 décembre 2008
26 nov. 2008 à 15:38
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
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
28 nov. 2008 à 09:18
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
Nepyim Messages postés 7 Date d'inscription samedi 22 novembre 2003 Statut Membre Dernière intervention 3 décembre 2008
28 nov. 2008 à 15:55
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