印鑑(ハンコ)を模したオートシェイプ

およそ一年ほど前、セルの真ん中に円を描画するマクロを紹介した。
infoment.hatenablog.com

今回はその発展として、印鑑(※以降「ハンコ」)っぽいオートシェイプの作成に挑戦する。
f:id:Infoment:20190713143338p:plain

個人的には残念なことに、世の中には未だ未だ
「印刷して、手書きしたうえでハンコを押す」
想定のExcel帳票が多数ある。そこで今回職場において、確信犯的にハンコを模した電子押印を作成することにした。


【仕 様】

  • 選択したセルの中心に、セルのサイズに合わせてハンコを描画。
    ただしハンコが馬鹿でかくならないよう、直径の上限は別途定めておく。
  • ハンコ内の文字は、縦書きとする。
  • ハンコの色は、全て赤色とする。
  • 名前の書体は、「HGS行書体」とする(何となく)。

以上を踏まえ、作成したのがこちら。

Sub SetStamp(target_range As Range, person_name As String)

    Dim StampDiameter As Double

        ' セルの外枠とハンコの縁が接しないよう、少し小さめに描画する。
        StampDiameter = WorksheetFunction.Min(target_range.Width,target_range.Height) * 0.9

        ' ハンコが際限なく大きくならないよう、直径の上限を30とする。
        If StampDiameter > 30 Then
            StampDiameter = 30
        End If

    ' セルの中心座標を元に、円の描画開始点を求める。
    Dim Sx As Double, Sy As Double
        Sx = target_range.Left + target_range.Width / 2 - StampDiameter / 2
        Sy = target_range.Top + target_range.Height / 2 - StampDiameter / 2

    Dim StampEdge As Excel.Shape
    Set StampEdge = ActiveSheet.Shapes.AddShape(msoShapeOval, Sx, Sy, StampDiameter, StampDiameter)

        ' ○の設定。
        With StampEdge
            .Fill.Visible = msoFalse
            .Line.ForeColor.RGB = RGB(255, 0, 0)
            .Line.Weight = 1
        End With

        ' ○内の文字設定。
        With StampEdge.TextFrame2
            .Orientation = msoTextOrientationVerticalFarEast
            .VerticalAnchor = msoAnchorMiddle
            .HorizontalAnchor = msoAnchorCenter

            .TextRange.Text = person_name

            With .TextRange.Font
                .NameFarEast = "HGS行書体"
                .Size = StampDiameter / 1.5 / Len(person_name)
                .Fill.ForeColor.RGB = RGB(255, 0, 0)
            End With

            ' 文字周辺の余白を0にすることで、出来るだけ名前の
            ' 表示を大きくできるようにする。
            .MarginBottom = 0
            .MarginLeft = 0
            .MarginRight = 0
            .MarginTop = 0
        End With

早速、「太郎」さんで試してみよう。

Sub Stamp()
    Dim PersonName As String
        PersonName = InputBox("名前入力", "押印", "太郎")

        SetStamp Selection, PersonName
End Sub

f:id:Infoment:20190713144155g:plain


とりあえず、上手くいったようだ。ただし「五十嵐」さんなど3文字の場合、文字が小さくなりすぎるか、または表示されない現象が起きている。その辺りのチューニングは、使用者にお任せとする。

なお、書類の種類や、書類受け取り部署のルールなどによってはNGの場合もあると思うので、使用の際は充分ご注意ください。

参考まで。