○第64回目 図形編(その2) 図形の一括作成
最初は図形の一括作成です。図形の選択はマクロの中で行ないます。実行前処理としては、書き込みたいテキストを選択することになります。
セルにテキストの内容を書いてその範囲を指定します。
この部分をセルの範囲座標の取得と内容の取得という基本的な機能で処理します。
また、追加でもいいことになるので、既存の図形の数も取っておきます。=⇒新規作成だけでなく追加機能も含んでいます。
図形の数は最大100としましたので、テキストの数も100とします。 Dim mm1(100)
テキストはエディタなどで作成しておいて、エクセルに貼り付けるのも一法です。
すでにエディタで整理してある文言を利用することにすると、手間が省けます。
図形の数は、 ii9 = ActiveSheet.Shapes.Count となります。
(コマンドが限られているので、ロジックが少なく意外と簡単なのです)
次は図形の選択です。
z_form = InputBox("図形の種類を入力してください。1…面取り長方形、2…楕円、3…爆発、4…噴出し、 ", , "1") としました。図形の種類は一回の処理ではひとつのみです。
これをもとに、作りたい図形の数だけ繰り返します。作成する図形の数は、有効行数なのでgyo_cntとなっています。
図形は、番号で管理します。
図形の作成は、Case文で分岐させています。
Select Case z_form
Case "1"
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 225.75, 822.75, 126#, 62.25).Select
Case "2"
:
Case Else
Exit Sub
End Select
となります。面取り長方形の場合です。
楕円の場合=⇒ ActiveSheet.Shapes.AddShape(msoShapeOval, (略))
爆発の場合=⇒ ActiveActiveSheet.Shapes.AddShape(msoShapeExplosion2, (略))
噴出しの場合=⇒ ActiveActiveSheet.Shapes.AddShape(msoShapeOvalCallout, (略))
テキストを入れます。
Selection.Characters.Text = mm1(i)
次に表示位置を決めます。この段階では、暫定的なので、あるセルを指定して、そこから斜めに展開しています。
ここでは図形の番号、位置の設定が出てきます。
位置は、簡単なようにセルの上と左にあわせるという形をとります。
まずは貼り付ける位置を設定します。
Dim セル範囲 As Range
Set セル範囲 = Application.InputBox(Prompt:="図形を並べる基準のセルを指定してください", Default:=AAA1, Left:=10, Top:=2, Type:=8)
aaa2 = セル範囲.Address
retu2 = Range(aaa2).Column
gyo2 = Range(aaa2).Row
位置は、
ActiveSheet.Shapes(j).Left = Cells(gyo2 + (i - 1) * 3, retu2 + i - 1).Left
ActiveSheet.Shapes(j).Top = Cells(gyo2 + (i - 1) * 3, retu2 + i - 1).Top
で指定します。一列右、三行下に図形が次々に移動します。(早くて見えませんけどね)
このでの"j"が図形の番号です。追加の場合もありますので、
j = ii9 + i 'ii9が既存の図形の個数
あとで出てきますが、図形に色をつける必要があります。その色見本を作ることが可能です。
連番を入れておき、それ番号に対応する色つけるという処理を一緒にするのです。
私を含めて、色のことをそれほど知らない人にとっては、あっと思うこと請け合いです。
'特別処理;色を付ける;色見本用
For i = 1 To gyo_cnt
ActiveSheet.Shapes(i).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = i
' SchemeColor = 51 '橙、10 '赤、13 '黄色、11 '黄緑、9 '白
Next i
※コマンドを探すのに苦労した割には、単純なマクロです。
今回のマクロでこれからのマクロの原型の機能がほとんど出ています。
これは大丈夫なのですが、図形の場合はよくエラーが出ますので、処理内容がチェックできたら、先頭に、 On Error Resume Next をいれて、エラーを回避するのも一法です。(共通注意事項。致命的なエラーの場合ははずして原因を突き止めてください)

0 件のコメント:
コメントを投稿