『メソッドがサポートされていませんのえらーについて』（東九）
Private Sub セル貼り付け()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim 対象シート As Worksheet
Dim 対象範囲 As Range
Dim 貼付図形 As Shape
Dim 一時チャート As ChartObject
Dim 画像保存先 As String
Set 対象シート = ActiveSheet
Set 対象範囲 = Selection
' セルを画像としてコピー
対象範囲.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' シートに貼り付け
対象シート.Paste
Set 貼付図形 = 対象シート.Shapes(対象シート.Shapes.count)
Dim 画像幅 As Single, 画像高さ As Single
画像幅 = 貼付図形.width + 5
画像高さ = 貼付図形.height
' 図形をチャートに貼り付けて画像化
貼付図形.Copy
' チャートの作成位置を指定する
Dim p As Range
Set p = 対象シート.Range("H1")
Set 一時チャート = 対象シート.ChartObjects.Add( _
p.Left, p.Top, 画像幅, 画像高さ)
一時チャート.Chart.Paste
画像保存先 = "D:\temp\cellImage.jpg"
一時チャート.Chart.Export Filename:=画像保存先, FilterName:="JPG"
' UserForm の Image1
With Me.Image1
.Picture = LoadPicture(画像保存先)
.width = 画像幅
.height = 画像高さ
End With
' 後片付け
一時チャート.Delete
貼付図形.Delete
ExitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
このコードは選択したセルを画像として一時チャートに貼り付けそれを保存します。
保存した画像を読み込みイメージコントロールに貼り付けます。
メソッドはサポートされていませんのエラーが出ます。
解決策を教えてください。
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
参考
https://excel-ubara.com/EXCEL/EXCEL916.html
（匿名） 2026/04/10(金) 16:29:43
# 直接の回答ではありません。
ChartObjectが持つChartオブジェクトが持つPasteメソッドという意味ですよね、そのコードは。 私の環境(365)では動作しています。 version問題かもしれませんね。
# Chartを経由せずに、別のツールでファイル保存して、それを読み込めばいいのかもしれません。 # LLMにでも尋ねてみたらいかがですか？ PowerPointを利用する方法があるようです。
（xyz） 2026/04/10(金) 17:16:38
↓UserForm_Clickでクリップボードにいるビットマップを自身のPictureに設定する例
Option Explicit
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Const CF_BITMAP = 2&
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
size As Long
Type As Long
hBmp As LongPtr
hPal As LongPtr
Reserved As Long
End Type
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As Long
Private Const PICTYPE_BITMAP = 1&
Private Function GetBmpfromClipboard() As LongPtr
If IsClipboardFormatAvailable(CF_BITMAP) = 0 Then Exit Function
If OpenClipboard(0&) <> 0 Then
GetBmpfromClipboard = GetClipboardData(CF_BITMAP)
Call CloseClipboard
End If
End Function
Private Function CreatePictureByhBmp(ByVal hBmp As LongPtr, Optional hPal As LongPtr) As IPictureDisp
Dim IID_IDispatch As GUID, Bmp As PicBmp
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0&
.Data4(7) = &H46&
End With
With Bmp
.size = Len(Bmp)
.Type = PICTYPE_BITMAP
.hBmp = hBmp
.hPal = hPal
End With
Call OleCreatePictureIndirect(Bmp, IID_IDispatch, 1, CreatePictureByhBmp)
End Function
Private Sub UserForm_Click()
Dim hBmp As LongPtr
hBmp = GetBmpfromClipboard()
If hBmp Then
Set Me.Picture = CreatePictureByhBmp(hBmp, 0&)
End If
End Sub
（白茶） 2026/04/10(金) 19:29:32
直前に↓を追加で解決しませんか。
一時チャート.select （マナ） 2026/04/10(金) 21:38:50
(xyz)さん。こちらは2013です。
version問題の問題ですね。
（白茶）さん。
設定する例のマクロ有難うございました。
内容を理解する力がありませんので参考にとどめておきます。
（マナ）さん。追加したらエラーは出なくなりました。
有難うございました。
（東九） 2026/04/11(土) 10:03:30
マナさんのご指摘のとおりでした。
私はステップ実行していたのでそれに気づきませんでした。 通常実行すると、エラーはでませんが貼り付けはされませんね。 versionによって振る舞いが違うようですが、 Excel365でも問題なく動作する訳ではなかったことを補足しておきます。
# SheetにPasteする場合と同じともいえますが、系列追加などでは必ずしもActivateが必須ではないので、 # ケースによってどのような振る舞いになるか調べるべきかもしれませんが、スキップします。
（xyz） 2026/04/11(土) 12:11:29
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.