Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Insérer une plage de cellules dans le commentaire

9 réponses
Avatar
Noegor
Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C3 de la
Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA).
Merci à celle ou celui qui saura.
Noégor

9 réponses

Avatar
lSteph
Bonsoir Noégor,

Pas convaincu que ce soit possible.
Un commentaire contient du texte, pas des cellules.

Cordialement.

lSteph


Noegor avait émis l'idée :
Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C3 de la
Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA).
Merci à celle ou celui qui saura.
Noégor


--
- -

Avatar
JB
Bonsoir,

Sub essai()
If [A1].NoteText = "" Then [A1].AddComment
For Each c In Sheets(2).Range("A1:C3")
temp = temp & Chr(10) & c
Next c
With [A1]
.Comment.Text Text:=temp
.Comment.Visible = True
.Comment.Shape.Select
Selection.AutoSize = True
.Comment.Visible = False
End With
End Sub

Cordialement JB

Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C3 de la
Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA).
Merci à celle ou celui qui saura.
Noégor


Avatar
JB
Autre présentation:

http://cjoint.com/?kDufyTdBmi

Sub essai2()
If [A1].NoteText = "" Then [A1].AddComment
For i = 1 To 3
For c = 1 To 3
temp = temp & Cells(i, c).Address(rowAbsolute:úlse,
columnAbsolute:úlse) & _
":" & Sheets(2).Cells(i, c) & " "
Next c
temp = temp & Chr(10)
Next i
With [A1]
.Comment.Text Text:=temp
.Comment.Visible = True
.Comment.Shape.Select
Selection.AutoSize = True
.Comment.Visible = False
End With
End Sub

JB

Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C3 de la
Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA).
Merci à celle ou celui qui saura.
Noégor


Avatar
JB
Maj du commentaire dès la saisie dans A1:C3

http://cjoint.com/?kDvCd8OaCY

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([A1:C3], Target) Is Nothing And Target.Count Then
If Sheets(1).[A1].NoteText = "" Then Sheets(1).[A1].AddComment
For i = 1 To 3
For c = 1 To 3
temp = temp & Cells(i, c).Address(rowAbsolute:úlse,
columnAbsolute:úlse) & _
":" & Sheets(2).Cells(i, c) & " "
Next c
temp = temp & Chr(10)
Next i
With Sheets(1).[A1]
.Comment.Text Text:=temp
.Comment.Shape.Width = 130
End With
End If
End Sub

JB





Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C3 de la
Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA).
Merci à celle ou celui qui saura.
Noégor


Avatar
Michel Pierron
Bonsoir Noegor;
Tu peux essayer d'insérer la plage en tant qu'image:

Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function OleCreatePictureIndirect& Lib _
"olepro32.dll" (PicDesc As PicBmp, RefIID As Guid _
, ByVal fPictureOwnsHandle&, IPic As IPicture)

Sub SaveRangeAsBmp()
Const Temp$ = "c:Tmp.bmp"
ThisWorkbook.Sheets(2).Range("A1:C3").CopyPicture 1, 2
OpenClipboard 0&
SavePicture CreatePicture(GetClipboardData(2)), Temp
EmptyClipboard
CloseClipboard
With ThisWorkbook.Sheets(1).Range("A1")
.ClearComments
.AddComment
.Comment.Text Text:=""
.Comment.Shape.Fill.UserPicture Temp
End With
On Error Resume Next
Kill Temp
End Sub

Private Function CreatePicture(ByVal hBmp&) As IPicture
Dim Ret&, Pic As PicBmp, IPic As IPicture, IID As Guid
With IID
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With Pic
.Size = Len(Pic)
.Type = 1
.hBmp = hBmp
End With
Ret = OleCreatePictureIndirect(Pic, IID, 1, IPic)
Set CreatePicture = IPic
End Function

MP

"Noegor" a écrit dans le message de news:
OJ9EfR4%
Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C3 de
la Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA).
Merci à celle ou celui qui saura.
Noégor



Avatar
Noegor
Bonsoir,
Grand merci...
J'ai même plusieurs façons de le faire alors que cela me paraissait
impossible!....
A très bientôt pour d'autres questions difficiles, car j'ai toujours mal à
ma "GetShortPathName" qui étant trop agée ne digère plus les "blancs". Voir
ma question du 21Juin à 21h44.
Cordialement
Noégor
"Michel Pierron" a écrit dans le message de news:
OU9Rwz5%
Bonsoir Noegor;
Tu peux essayer d'insérer la plage en tant qu'image:

Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function OleCreatePictureIndirect& Lib _
"olepro32.dll" (PicDesc As PicBmp, RefIID As Guid _
, ByVal fPictureOwnsHandle&, IPic As IPicture)

Sub SaveRangeAsBmp()
Const Temp$ = "c:Tmp.bmp"
ThisWorkbook.Sheets(2).Range("A1:C3").CopyPicture 1, 2
OpenClipboard 0&
SavePicture CreatePicture(GetClipboardData(2)), Temp
EmptyClipboard
CloseClipboard
With ThisWorkbook.Sheets(1).Range("A1")
.ClearComments
.AddComment
.Comment.Text Text:=""
.Comment.Shape.Fill.UserPicture Temp
End With
On Error Resume Next
Kill Temp
End Sub

Private Function CreatePicture(ByVal hBmp&) As IPicture
Dim Ret&, Pic As PicBmp, IPic As IPicture, IID As Guid
With IID
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With Pic
.Size = Len(Pic)
.Type = 1
.hBmp = hBmp
End With
Ret = OleCreatePictureIndirect(Pic, IID, 1, IPic)
Set CreatePicture = IPic
End Function

MP

"Noegor" a écrit dans le message de news:
OJ9EfR4%
Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C3 de
la Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA).
Merci à celle ou celui qui saura.
Noégor







Avatar
lSteph
Bonsoir Michel,

En voilà une qui est bien et ... je la garde!
Je pataugeais dans mes mesures de chr(151), chr(126) et de
quantification des espaces dont la taille n'est jamais en
coincidence avec les caractères à combler dans la largeur.

Bravo pour cette solution.

lSteph




Michel Pierron a présenté l'énoncé suivant :
Bonsoir Noegor;
Tu peux essayer d'insérer la plage en tant qu'image:

Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function OleCreatePictureIndirect& Lib _
"olepro32.dll" (PicDesc As PicBmp, RefIID As Guid _
, ByVal fPictureOwnsHandle&, IPic As IPicture)

Sub SaveRangeAsBmp()
Const Temp$ = "c:Tmp.bmp"
ThisWorkbook.Sheets(2).Range("A1:C3").CopyPicture 1, 2
OpenClipboard 0&
SavePicture CreatePicture(GetClipboardData(2)), Temp
EmptyClipboard
CloseClipboard
With ThisWorkbook.Sheets(1).Range("A1")
.ClearComments
.AddComment
.Comment.Text Text:=""
.Comment.Shape.Fill.UserPicture Temp
End With
On Error Resume Next
Kill Temp
End Sub

Private Function CreatePicture(ByVal hBmp&) As IPicture
Dim Ret&, Pic As PicBmp, IPic As IPicture, IID As Guid
With IID
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With Pic
.Size = Len(Pic)
.Type = 1
.hBmp = hBmp
End With
Ret = OleCreatePictureIndirect(Pic, IID, 1, IPic)
Set CreatePicture = IPic
End Function

MP

"Noegor" a écrit dans le message de news:
OJ9EfR4%
Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C3 de
la Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA).
Merci à celle ou celui qui saura.
Noégor




--
- -


Avatar
JB
Sur mon poste (Excel 2003), l'image est déformée. Il faut 'corriger'
la hauteur.

http://cjoint.com/?kEfNHjOdmo

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([A1:C3], Target) Is Nothing And Target.Count Then
With Sheets(2)
.[A1:C3].CopyPicture
.Paste Destination:=.Range("A1") 'crée un shape
Set s = .Shapes(.Shapes.Count)
s.CopyPicture
.ChartObjects.Add(0, 0, s.Width, s.Height * 1.4).Chart.Paste
.ChartObjects(1).Chart.Export Filename:="monimage.jpg",
FilterName:="jpg"
.Shapes(.Shapes.Count).Delete
.Shapes(.Shapes.Count).Delete
End With
With Sheets(1).Range("A1")
.ClearComments
.AddComment
.Comment.Shape.Fill.UserPicture "Monimage.jpg"
End With
End If
End Sub



Bonsoir Noegor;
Tu peux essayer d'insérer la plage en tant qu'image:

Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function OleCreatePictureIndirect& Lib _
"olepro32.dll" (PicDesc As PicBmp, RefIID As Guid _
, ByVal fPictureOwnsHandle&, IPic As IPicture)

Sub SaveRangeAsBmp()
Const Temp$ = "c:Tmp.bmp"
ThisWorkbook.Sheets(2).Range("A1:C3").CopyPicture 1, 2
OpenClipboard 0&
SavePicture CreatePicture(GetClipboardData(2)), Temp
EmptyClipboard
CloseClipboard
With ThisWorkbook.Sheets(1).Range("A1")
.ClearComments
.AddComment
.Comment.Text Text:=""
.Comment.Shape.Fill.UserPicture Temp
End With
On Error Resume Next
Kill Temp
End Sub

Private Function CreatePicture(ByVal hBmp&) As IPicture
Dim Ret&, Pic As PicBmp, IPic As IPicture, IID As Guid
With IID
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With Pic
.Size = Len(Pic)
.Type = 1
.hBmp = hBmp
End With
Ret = OleCreatePictureIndirect(Pic, IID, 1, IPic)
Set CreatePicture = IPic
End Function

MP

"Noegor" a écrit dans le message de news:
OJ9EfR4%
Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C 3 de
la Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA ).
Merci à celle ou celui qui saura.
Noégor





Avatar
JB
Une alternative au commentaire (simple et préserve la qualité de
l'image)

http://cjoint.com/?kEgRykawu1

-Créer un shape
-Dans la barre de formule: þuil2!$A$1:$C$3

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then
Sheets(1).Shapes("monshape").Visible = True
Else
Sheets(1).Shapes("monshape").Visible = False
End If
End Sub

JB

Bonsoir à Tous,
Sous Xp, Excel2002, je souhaiterais insérer la plage de cellules A1:C3 de la
Feuil2, dans le commentaire de la cellule A1 de la feuil1...( en VBA).
Merci à celle ou celui qui saura.
Noégor