ダブルクリックで吹き出しを追加する
ユーザーから指示をもらうために、簡便的に作ったマクロです。
どの部分の調整をしたいのかが、口頭だと伝わりづらく、また簡単に伝えたいというジレンマ。
(口頭のがはやいという考えもあり、それに対応したコードです)
ダブルクリックすることで下記のようなオートシェイプが吹き出しとしてできあがります。

ダブルクリックで吹き出しを追加するサンプルコード
'■ダブルクリックでシートに吹き出しを追加する。 WorkSheetモジュールに記載する
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'■以下の設定もしくは★マーク部分をいじる
Dim sWidth As Long: sWidth = 60
Dim sHeight As Long: sHeight = 30
Dim sLeftAdjust As Long: sLeftAdjust = 50 'シェイプの位置調整(横) マイナスで左にプラスで右にずれる
Dim sTopAdjust As Long: sTopAdjust = -40 'シェイプの位置調整(縦) マイナスで上にプラスで下にずれる
Dim sText As String: sText = "CHECK"
'■オートシェイプを追加(ふきだし)
With Target
With .Parent.Shapes.AddShape(msoShapeRectangularCallout, .Left + 50, .Top - 40, sWidth, sHeight)
.Line.Visible = msoFalse
.Adjustments.Item(1) = -0.5 '★吹き出し位置
.Adjustments.Item(2) = 1 '★吹き出し長さ
.TextFrame.Characters.Text = sText '★文字内容
.TextFrame.Characters.Font.Size = 15 '★文字サイズ(フォントサイズ)
End With
End With
Cancel = True
End Sub



コメント