捺印を1クリックでできるマクロ

1クリックでExcelに捺印できるマクロを紹介します。

Sub 捺印()
    
    Dim objFileName As String
    Dim objShape As Shape
    Dim Size As Long
    
    objFileName = Range("ファイル名")
    Size = Range("サイズ")

    'アクティブセルの位置に図の幅と高さを ポイントを指定して画像を挿入します
    Set objShape = ActiveSheet.Shapes.AddPicture( _
        Filename:=objFileName, _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=ActiveCell.Left, _
        Top:=ActiveCell.Top, _
        Width:=Size, _
        Height:=Size)

    ' セルの中央に移動
    objShape.Left = (ActiveCell.Left + (ActiveCell.MergeArea.Width - objShape.Width) / 2) * 1
    objShape.Top = (ActiveCell.Top + (ActiveCell.MergeArea.Height - objShape.Height) / 2) * 1
    
End Sub

設定は、シート「捺印」の以下で設定します。画像ファイルの保存先は、必須です。サイズは、捺印後、必要に応じて調整してください。