【Excel VBA】【マクロ】【Tips】いつも決まった図形を簡単に作成するマクロ（「済」ハンコマクロ）

こんにちは！Lenocoです。本日も見てくださりありがとうございます。

今回は図形作成についてのTips回です！！！

Contents

同じ図形を使うことありませんか？
「済」ハンコの図形を作ってみよう！

コード
コードの説明

まとめ

同じ図形を使うことありませんか？

いつも決まった図形を使うことってないでしょうか？
同じ種類の図形、同じ色、同じ書式・・・
毎回同じ設定をするのは面倒なので前のファイルからコピーしてきて文字を消して使う。。

今回はそんな面倒な作業を楽にしようというマクロです！！
私が使っている、ToDoリストが完了したら「済」というハンコを押していくマクロをご紹介します。

「済」ハンコの図形を作ってみよう！

簡単にToDoリストを作ってみました。

「済」ハンコの図形を作成するマクロは、Ctrl+Qにショートカット登録しています。
1～3のタスクが終了したとして、E列のそれぞれのセルでCtrl+Qを押すと・・

このような感じで、セルの真ん中に「済」と書かれた図形が作成されます。
これでどのタスクが完了したのか一目瞭然ですね！
それではコードを見ていきましょう～

コード

Sub CreateSumiStamp()
    Dim sumiShape As Shape
    Dim shLeft As Single
    Dim shTop As Single
    
    If ActiveCell.Width < ActiveCell.Height Then
        shTop = ActiveCell.Top + (ActiveCell.Height - (ActiveCell.Width - 2)) / 2
        Set sumiShape = ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, Left:=ActiveCell.Left + 1, Top:=shTop, Width:=ActiveCell.Width - 2, Height:=ActiveCell.Width - 2)
    Else
        shLeft = ActiveCell.Left + (ActiveCell.Width - (ActiveCell.Height - 2)) / 2
        Set sumiShape = ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, Left:=shLeft, Top:=ActiveCell.Top + 1, Width:=ActiveCell.Height - 2, Height:=ActiveCell.Height - 2)
    End If

    With sumiShape
        .Fill.Visible = msoFalse
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .Line.Weight = 1.5
        
        With .TextFrame
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
        End With
        
        With .TextFrame2.TextRange
            .Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
            .Font.NameFarEast = "Meiryo UI"
            .Font.Size = 16
            .Characters.Text = "済"
        End With
    End With
End Sub

コードの説明

変数を宣言します。
図形を操作するためのShape型の「sumiShape」、図形の座標設定用のSingle型「shLeft」「shTop」を用意します。
まずは、元となる楕円の図形を置いていきます。その際、セルのサイズを見てセルの真ん中に図形を置くようにします。
If文で選択されているセルの横幅と縦幅を比較し、縦幅の方が大きい場合、If文の上の枠に入ります。
図形のTopの座標を保存します。式の内容は以下です。
shTop = 選択セルのTop座標＋（選択セルの横幅－図形の一辺の幅）/２
なお、図形の縦横のサイズは、選択セルの小さいほうの幅-2としています。
上記の場合は、選択セルの横幅の方が小さいため、「選択セルの横幅-2」としています。
AddShapeメソッドを使用し、楕円の図形を作成します。各引数に以下の内容を設定しています。
Type（図形の種類）：msoShapeOval
Left（図形左位置）：選択セルの左位置+1
Top（図形上位置）：先ほど作成したshTopの値
Width（図形横幅）：選択セル横幅-2
Height（図形縦幅）：選択セル横幅-2
逆に、選択セルの横幅が縦幅以下の場合はElseの枠に入ります。
先ほどとほとんど同じですが、今度は選択セルの横幅の方が大きいので、一部指定している値が変わっています。
どこが変わっているか、よく見てみてください！
If文は以上です。

続いて、図形の設定です。
Withを使って「sumiShape」、「.TextFrame」、「.TextFrame2.TextRange」の記述を省略しています。
※Withについてより詳しく知りたい方は過去のブログ「Withとオブジェクト変数を使ってコードを見やすくシンプルに！」をご確認ください。
「sumiShape」の設定です。
図形の塗りつぶしを「塗りつぶしなし」に設定し、図形の枠線を赤色、太さを「1.5pt」に設定します。
次に「sumiShape.TextFrame」の設定です。
テキスト位置を上下左右中央に設定します。
次に「sumiShape.TextFrame2.TextRange」の設定です。
フォントの色を赤色、フォント書式を「Meiryo UI」、フォントサイズを「16」に設定し、
最後にテキスト「済」を設定します。
※「.Characters.Text=”済”」ですが、一番最後に持ってくるようにしてください。
「Wth .TextFrame2.TextRange」内の先頭に持ってきてしまうとなぜか書式がうまく設定されないので。。
フォントサイズは必要に応じて変更してくださいね。