VBAでクリップボードに画像を送る（手抜き版）

今時.NET、そしてPowerShellの動かないWindows PCはそうそう無いだろうということで、PowerShellを使って何とかする。

VBAでクリップボードに画像を送る

Sub ClipImage(ByVal imagePath As String)
    Const PS_PARAMS$ = "PowerShell.exe -NoProfile -Sta -WindowStyle Hidden ", _
          EXEC_CMD1$ = " -Command Add-Type -AssemblyName System.Windows.Forms,System.Drawing;[System.Windows.Forms.Clipboard]::SetImage([System.Drawing.Bitmap]'"
    Call VBA.Shell(PS_PARAMS & EXEC_CMD1 & imagePath & "')")
End Sub

使用イメージ

Call ClipImage("C:\hoge.png")

PowerShellでやっていること

# 必要なアセンブリロード
Add-Type -AssemblyName System.Windows.Forms,System.Drawing
# クリップボードに画像を送る
[System.Windows.Forms.Clipboard]::SetImage( #
    # 文字列を[System.Drawing.Bitmap]にキャストしようとすると
    # [System.Drawing.Bitmap]::FromFile 相当の処理がPowerShellから呼ばれる。
    [System.Drawing.Bitmap]' ここに引数のimagePathが埋め込まれる '
)

見ての通りエラー処理、不正な文字列の検知などを一切行っていないので
使用は自己責任でお願いします。

なお、ExcelやPowerPointなどの文書ベースのOfficeなら画像を形状として文書内に取り込めるため
画像を挿入してCopyメソッド使った方が早いと思われます。

参考PowerPoint版

Sub ClipImagePpt(ByVal imagePath As String)
    Const ppLayoutBlank& = 12, msoFalse& = 0, msoTrue& = -1
    With VBA.CreateObject("PowerPoint.Application")
        With .Presentations.Add
            With .Slides
                If .Count = 0 Then Call .Add(1, ppLayoutBlank)
                .Item(1).Shapes.AddPicture(imagePath, msoFalse, msoTrue, 0, 0).Copy
            End With '.Slides
            .Saved = msoTrue
            .Close
        End With '.Presentations.Add
    End With 'VBA.CreateObject("PowerPoint.Application")
End Sub