印鑑(ハンコ)を模したオートシェイプ
およそ一年ほど前、セルの真ん中に円を描画するマクロを紹介した。
infoment.hatenablog.com
今回はその発展として、印鑑(※以降「ハンコ」)っぽいオートシェイプの作成に挑戦する。
個人的には残念なことに、世の中には未だ未だ
「印刷して、手書きしたうえでハンコを押す」
想定の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
とりあえず、上手くいったようだ。ただし「五十嵐」さんなど3文字の場合、文字が小さくなりすぎるか、または表示されない現象が起きている。その辺りのチューニングは、使用者にお任せとする。
なお、書類の種類や、書類受け取り部署のルールなどによってはNGの場合もあると思うので、使用の際は充分ご注意ください。
参考まで。