第68回目 図形編(その6) 図形の削除、図形番号の付加、大きさ変更

○第68回目　図形編(その6)　図形の削除、図形番号の付加、大きさ変更
　※マクロはエクセル2007でのものです。2003でも動きました。

　1.図形の削除(図形番号を指定。範囲指定も可とする)
　このマクロはほとんど、入力された図形番号の分析となります。
　範囲の与え方としては、0(全部)、3、2-8、-5、4-を考えます。
　どこかでやっていますが、ポイントは-の位置になります。
　ないケース、先頭にあるケース、末尾にあるケース、それ以外にあるケース。
　それぞれにわけて入力値を分解していきます。当然ながら最後は、すでにある図形の数(ii9 = ActiveSheet.Shapes.Count)となります。

　入力から分解です
　z_no = InputBox("削除したい図形の番号を入力してください。　" & ii9 & "　以内", , "0")
　p1 = InStr(z_no, "-")
　If p1 = 1 Then　　'先頭に-がある場合
　　no1 = 1
　　no9 = Val(Mid(z_no, p1 + 1))　　'Valは数値変換する関数
　Else
　　If p1 = Len(z_no) Then　　'末尾に-がある場合
　　　no1 = Val(Left(z_no, p1 - 1))
　　　no9 = ii9
　　Else
　　　If p1 <> 0 Then　　'先頭、末尾以外の場所に-がある場合
　　　　no1 = Val(Left(z_no, p1 - 1))
　　　　no9 = Val(Mid(z_no, p1 + 1))
　　　Else
　　　あとは0の場合と、単独の場合ですので自分で考えてください。

　削除のコマンドは
　ActiveSheet.Shapes(i).Delete です。
　ここで注意点があります。
　頭から削除してすると、後の図形番号が一つずつ小さくなり変わってしまうのです。
　ですから、最後から削除していきます。
　そのために、for文の更新を-1にしていきます。stepで与えます。
　For i = no9 To no1 Step -1

　おしまい。

　2.図形のテキストに図形番号を付加するまたは図形番号を削除する
　　(図を見ただけで番号がわかるようにします。不要になれば消せます)
　これは当然、線とかコネクタにはつきません。エラーになるので、エラーになった場合は回避します。
　付加する形は、_12___ＸＸＸＸＸＸ、アンダーバー1つと、アンダーバー3つとで番号を囲みます。これが付加されている番号の特徴となります。
　1.全部の図形のテキストを取得して、それに図形番号がついていなければつけます。ついていれば、それを削除します。
　全部が対象になりますので、処理は、"1からii9 = ActiveSheet.Shapes.Count"までとなります。
　　ActiveSheet.Shapes(i).Select
　　mm1 = Selection.Characters.Text
　　p1 = InStr(mm1, "___")　　'p1は最初のアンダーバーの文字位置となります
　　If p1 = 0 Then　　'特殊文字がついていないので付加します
　　　 Selection.Characters.Text = "_" & i & "___" & mm1
　　Else　　　　　　　'特殊文字がついているので削除します
　　　 Selection.Characters.Text = Mid(mm1, p1 + 3)
　　End If

　おしまい。
　※いい忘れましたが、セルの座標の取得は必要ないのですが、最初にセルの座標を取得しておいて、最後にそのセルにフォーカスを戻してください。忘れますと図形にフォーカスが移ったままとなります。
　最初と最後に、それぞれ記述しておいてください。
　最初；　AAA = Selection.Address
　最後；　Range(AAA).Select

　3.大きさの修正(倍率を指定。縦横同時のみならず、縦だけ、横だけも可とする)

　範囲指定も可能とします。
　1.大きさを修正する図形の範囲を入力する
　2.大きさ変更の種類を入力する
　3.倍率を入力する。100を基準とする
　4.大きさを計算して、図形の大きさを変更する

　1.は、大きな《1.》で出てきました。
　2.は、これも定番です。
　'処理区分の入力。
　　kubun = InputBox("処理区分を入れてください。" & vbCrLf & _
　　"１=⇒縦横同時変更" & vbCrLf & _　　'"vbCrLf"は改行のこと
　　"２=⇒縦のみ変更" & vbCrLf & _
　　"３=⇒横のみ変更" & vbCrLf & _
　　"　" & vbCrLf _
　　, xpos:=2000, ypos:=3000, Default:=1)

　3.は、初期値として120を設定しました。

　4.は…
　まずは、大きさの計算です。そのために最初の大きさを取得します。
　　ActiveSheet.Shapes(i).Select
　　hig = Selection.ShapeRange.Height
　　wid = Selection.ShapeRange.Width
　となります。
　変更後の大きさは、0.25刻みにします。
　 hig2 = Int(hig * (h_rate / 100) * 4 + 0.5) / 4　　'h_rateは倍率
　　wid2 = Int(wid * (w_rate / 100) * 4 + 0.5) / 4　　'w_rateは倍率
　図形の大きさを変更するコマンドは、
　　Selection.ShapeRange.Height = hig2
　　Selection.ShapeRange.Width = wid2
　です。

　ほとんど既存のものを使いまわせますので、簡単に出来ます。

　おしまい。