Inserer image de cellule A1 dans le commentaire de la cellule B2

[tennis]

Bonjour,

J'ai dans une liste A1:A10 des noms correspodant à des cellules B1:B10 à l'intérieur desquelles j'ai mis des dessins appropriés à chacune des cellules correspondantes...

Ensuite, en fonction du choix (d'aprés la liste A1:A10) que je vais effectué dans la cellule B2, j'aimerais que lorsque je survole cette même cellule, je puisse voir apparaître le commentaire avec l'image (B1:B10) dans le commentaire...

Merci beaucoup de m'aider dans cette recherche

 

[BOISGONTIER]

Re : Inserer image de cellule A1 dans le commentaire de la cellule B2

Voir PJ

Les images ne sont ni nommées ni groupées.

Récupération d'un champ dans un commentaire
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 4 Then
    répertoire = ThisWorkbook.Path
    lig = [liste].Find(Target, LookAt:=xlWhole).Row
    col = [liste].Column + 1
    Cells(lig, col).CopyPicture
    x = ActiveCell.Width
    y = ActiveCell.Height
    ActiveSheet.Paste Destination:=Range("A1")  'crée un shape
    Set s = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    s.Copy
    With ActiveSheet
        .ChartObjects.Add(0, 0, s.Width, s.Height * 1.15).Chart.Paste
        .ChartObjects(1).Border.LineStyle = 0
        .ChartObjects(1).Chart.Export Filename:=répertoire & "\monimage.gif", FilterName:="gif"
        .Shapes(ActiveSheet.Shapes.Count).Delete
        .Shapes(ActiveSheet.Shapes.Count).Delete
    End With
    Target.Comment.Delete
    Target.AddComment
    Target.Comment.Shape.Fill.UserPicture répertoire & "\monimage.gif"
    Target.Comment.Shape.Height = y
    Target.Comment.Shape.Width = x
  End If
End Sub

JB

 

[tennis]

Re : Inserer image de cellule A1 dans le commentaire de la cellule B2

MERCI BEAUCOUP

Mon problème est resolu

BRAVO

Merci et à bientot

 

[tennis]

Re : Inserer image de cellule A1 dans le commentaire de la cellule B2

Rebonjour,

Désolé PJ mais je reviens vers vous pour une toute dernière modification... J'ai bien essayé mais impossible d'y arriver sans de l'aide...

En fait je souhaiterais simplement faire que ma base de shéma soit dans une feuille et que la sélection puis l'affichage des commentaires se passe dans une autre feuille...

Croyez-vous que ce soit possible de m'aider une toute dernière fois.

Merci beaucoup

 

[BOISGONTIER]

Re : Inserer image de cellule A1 dans le commentaire de la cellule B2

Voir PJ

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 2 Then
    répertoire = ThisWorkbook.Path
    lig = [liste].Find(Target, LookAt:=xlWhole).Row
    col = [liste].Column + 1
    Sheets("dessins").Cells(lig, col).CopyPicture
    x = Sheets("dessins").Cells(lig, col).Width
    y = Sheets("dessins").Cells(lig, col).Height
    ActiveSheet.Paste Destination:=Range("A1")  'crée un shape
    Set s = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    s.Copy
    With ActiveSheet
        .ChartObjects.Add(0, 0, s.Width, s.Height * 1.15).Chart.Paste
        .ChartObjects(1).Border.LineStyle = 0
        .ChartObjects(1).Chart.Export Filename:=répertoire & "\monimage.gif", FilterName:="gif"
        .Shapes(ActiveSheet.Shapes.Count).Delete
        .Shapes(ActiveSheet.Shapes.Count).Delete
    End With
    On Error Resume Next
    Target.Comment.Delete
    Target.AddComment
    Target.Comment.Shape.Fill.UserPicture répertoire & "\monimage.gif"
    Target.Comment.Shape.Height = y
    Target.Comment.Shape.Width = x
  End If
End Sub

JB

 

[tennis]

Re : Inserer image de cellule A1 dans le commentaire de la cellule B2

MERCI BEAUCOUP

C'est très gentil à vous d'avoir pris tout ce temps pour m'aider... Votre fichier semble fonctionner à merveille... J'espère également qu'il est possible d'effectuer l'affichage de commentaire dans plusieurs autres cellules que B2...

Merci encore
Bonne soirée

 

[BOISGONTIER]

Re : Inserer image de cellule A1 dans le commentaire de la cellule B2

Dans la colonne 2( If Target.Column = 2 Then).
Copier/Coller du menu.

http://boisgontierjacques.free.fr/fichiers/Commentaires/CommentaireRecupChamp.xls

JB