第77回目 グラフにコメントをつける(その3：おまけ)

○第77回目　グラフにコメントをつける(その3：おまけ)

　作成できる図形の対象として、垂直線、水平線を追加します。
　それをグラフ上に表示して、グラフに区切りをつけるというように利用します。
　あわせて矢印図形もつけて、これまでは実績で、ここからは推計とコメントします。
　左向き矢印、"これまでは実績"、垂直線、"ここからは推計"、右向き矢印　とグラフに表示するものです。
　さらに、コメントとして使用するので、図形の外枠を消しておきたい場合がありますので、外枠のオン･オフを指定します。あわせて、内部の文字のフォントサイズも変更します。欲張るときりがありませんが、もう一つ、線の太さと矢印のオン･オフについても紹介します。
　(これらはすべて図形作成システムにも同じように利用できます)
【機能】
　1.垂直直線、水平線を描く
　2.図形の外枠をつけたり消したりする
　3.コメントのフォントの種類とサイズを変更する
　4.線の太さを変更する
　5.矢印をつけたり消したりする

　1.垂直直線、水平線を描く
　　垂直直線の場合
ActiveSheet.Shapes.AddLine(82.5, 875.25, 82.5, 972#).Select
　　水平線の場合
ActiveSheet.Shapes.AddLine(1296.75, 218.25, 1505.25, 218.25).Select

　2.図形の外枠をつけたり消したりする
　　外枠をつける場合
ActiveSheet.Shapes(i).Select
Selection.ShapeRange.Line.Visible = msoTrue
　　外枠を消す場合
ActiveSheet.Shapes(i).Select
Selection.ShapeRange.Line.Visible = msoFalse

　3.コメントのフォントの種類とサイズを変更する
　　フォントの種類を変更する場合
　　・フォントの種類を入力します。
　　 fo_syurui = InputBox("フォントの種類を入れてください。" & vbCrLf & _
　　 "０=⇒そのまま" & vbCrLf & _
　　 "１=⇒ＭＳ Ｐゴシック" & vbCrLf & _
　　 "２=⇒　　　" & vbCrLf & _
　　 "３=⇒ＭＳ 明朝" & vbCrLf & _
　　 "４=⇒HGP創英角ﾎﾟｯﾌﾟ体" & vbCrLf & _
　　 "５=⇒　　　" & vbCrLf & _
　　 "　" & vbCrLf _
　　 , xpos:=2000, ypos:=3000, Default:=0)
　　・フォント種類の変換(フォントの名前を調べる必要があります。一例)
　　 Select Case fo_syurui
　　 'ＭＳ Ｐゴシック
　　 Case "1"
　　 fo_na = "ＭＳ Ｐゴシック"
　　 fo_sty = "太字"
　　・フォント種類の変更
ActiveSheet.Shapes(i).Select
With Selection.Font
.Name = fo_na
.FontStyle = fo_sty
End With
　フォントのサイズを変更する場合
　・フォントのサイズの入力。
　 fo_siz = InputBox("フォントのサイズを入れてください。" & vbCrLf & _
　 "6/8/9/10/11/12/14/16/18/20/22/24/26/28/36/48/72のいずれか" & vbCrLf _
　 , xpos:=2000, ypos:=3000, Default:=12)
　・フォントのサイズの変更
ActiveSheet.Shapes(i).Select
With Selection.Font
.Size = Val(fo_siz)
End With

　4.線の太さを変更する(※ラインとコネクタの場合のみです。他の図形は試していません。エラーになるかも知れません)
　　太さを入力して、0.25刻みに調整する
　 hutosa = InputBox("太さを入力してください。0.25単位で近いところにします　", , 2)
　 hutosa = Int((hutosa * 4 + 0.5)) / 4
　　太さを変更する
ActiveSheet.Shapes(i).Select
Selection.ShapeRange.Line.Weight = hutosa

　5.矢印をつけたり消したりする(※ラインとコネクタの場合のみです。他の図形は試していません。エラーになるかも知れません)
両方の矢印なしの場合
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadNone
――→の場合
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
←――の場合
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
←―→の場合
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle

　※4.と5.で、『ラインとコネクタの場合のみです。他の図形は試していません。エラーになるかも知れません』と記載しましたが、これは一般的にいえることで、他の図形にはあるがライン等にはないもの(テキスト、外枠)があります(逆もあります。太さ、矢印など)。図形の種類ごとにエラーが起きないように、矛盾しない処理にしてください。
　現時点でトラブルが多いのが、ライン(特にラインからテキストを取得しようとした場合。結果がコネクタともちょっと違う)の場合です。
　ということで、この対応としては、次のようにしています。
　　※コネクタとラインの場合は処理を除外する例
ActiveSheet.Shapes(i).Select
mm2(i) = Selection.Name　　'図形の名前を取得
return_V1 = Selection.ShapeRange.Connector　　'ラインにはこのようなコマンドが見つからない。
If return_V1 <> -1 Then　　'コネクタの場合は-1となるので対象外となる
If InStr(mm2(i), "Line") = 0 Then　　'図形の名前からで判断。エクセル2003でのもの。ラインは対象外となる。
mm1(i) = Selection.Characters.Text
End If
End If

　※ライン関係のエラー対応については、かなり苦労しました。

第76回目 グラフにコメントをつける(その2)

○第76回目　グラフにコメントをつける(その2)

　このシステムの他の機能です。
　・テキストの取得･書出し(ワークシートに)
　・テキスト(コメント)の修正
　・図形(ひとつ)の移動

　グラフシートの場合の最大のポイントは、セルがないことです。したがって、図形システムの該当するマクロから、グラフシートにある時は、エラーになるのでセル関係の記述を削除します。また、グラフシートとワークシートの移動を考えます。

　1.テキストの取得･書出し(ワークシートに)
　"図形のテキストの取得_書き込み"をもとにして、
　まずは、"指定範囲の取得"を削除して、'テキスト、"図形名の取得"から始まります。
　テキストを格納した段階で、シートを変えます(前回参照)。
　ワークシートになりますので、テキストを書き込む先頭のセルを指定します。
　それをもとに、セルの行番号と列番号を求めます。
bbb = ActiveCell.Address
Set セル範囲 = Application.InputBox(Prompt:="貼り付けるセルを選択してください", Default:=bbb, Left:=10, Top:=2, Type:=8)
AAA = セル範囲.Address
AAA1 = AAA
retu1 = Range(AAA1).Column
gyo1 = Range(AAA1).Row

　後は貼付けです。
図形の数は、グラフシートの段階で求めておいた、 ii9 = ActiveSheet.Shapes.Count　です。

　2.テキスト(コメント)の修正
　このマクロでは、ワークシートからグラフシートに移動します。
　"図形のテキストの修正"の最初から利用できます。
　図形にテキストを書き込む時になって、グラフシートに移動させます。その後に既存のマクロの通りコメントの修正をします。
　最後の場所をグラフシートのままでよければ、テキスト修正後、終了させます。
　だんだん同じプログラムを何個も作るのがいやになってきます。もっとサブルーチン化して、同じ機能は原則1箇所のみの記述にはならないものでしょうか。

　3.図形(ひとつ)の移動
　このマクロは、グラフシートのままで出来ます。
　そして前回の"グラフにコメントをつける"の後半の位置を指定する直前に、図形番号の指定をいれればほぼ完成です。
　図形番号の指定は、図形の削除あたりを参照してください。

　今回は何かすっきりしないものを感じておわりにします。
　テーマは、ワークシート上の図形とグラフシート上の図形の処理を、すっきりしたマクロシステムとするということです。
　基本的な変数はモジュール変数とする。(モジュール内で共有できる変数。内容が他のマクロにも利用可能となる)
　モジュール内のマクロ間に共通変数をもたせることによって、より細分化したサブルーチンマクロをつくる。
　そして、サブルーチンマクロを組み立てることによって、メインシステムを簡略化し、システム全体をすっきりとさせる。

第75回目 グラフにコメントをつける

○第75回目　グラフにコメントをつける

　図形の説明を続けてきましたが、今回は、グラフとの結合です。といってもだいそれたものではなく、グラフ上にコメントをつけることです(コメントと象徴的にいっていますが、テキスト入り図形のことです)。
　ポイントは、グラフシートにはセルがないことです。
　グラフ上でのセルの指定はすべてエラーになりますので、その点を無視する(エラー回避する)ような、手を講じれば、図形システムからマクロを移植できます。
　次の問題は場所についてです。セルによる指定ではなく、水平値、垂直値によって指定します。水平値は60から580、垂直値は30から350の範囲で指定すればいいと思います(グラフシートごとに微調整が必要だと思います)。
　図形の左上の位置を水平軸、垂直軸を20分割してその単位で指定することにします。端数入りで入力すればもっと細かい単位で位置が指定できます。
　水平軸で表せば、"60+26*入力値"が位置となります。
　 ActiveSheet.Shapes(z_no).Left = 60 + 26 * x_pos
　 ActiveSheet.Shapes(z_no).Top = 30 + 16 * y_pos
　こんな感じですね。
　更に、ワークシートとグラフシートの間での移動が不可欠です。

【手順】
　0.コメント文をワークシートに書き込みその箇所(複数も可)を指定し、実行する。
　1.セル指定範囲を取得し、コメントも取得する。
　2.グラフシートへの移動。相対的位置(現在のシートから-1、0、+1とか)で指定する。
　3.グラフ上の図形の場所を指定する。
　4.グラフ上で図形を描き、あわせて指定した場所に移動する。

　1.定番なので省略
　2.グラフシートへの移動
　　シートの移動は相対位置(現在のシートから-1、0、+1とか)で指定します。
　　初期情報もとっておきましょう。
ii_max = ActiveWorkbook.Sheets.Count
ii0 = ActiveSheet.Index
sh_cnt = InputBox("グラフシートの場所を入れてください。… -1 , 0 , 1 …など", Default:=-1, xpos:=2000, ypos:=3000)
その後、グラフシートを選択します。
Sheets(ii0 + sh_cnt).Select
現在位置はii0ですので、相対位置の意味合いはわかりますね。

3.グラフ上の位置の指定
グラフ上を、上下20等分にわけ、その位置の指定をします。図形でちょうど真ん中というのは難しいでしょう。真ん中の目安は10となります。
グラフの状況で設定した数値がグラフ域と同じとは限りません。調整するか、どうかですが、マイナスの数値が入りますので、設定ワークシートよりちょっと左とか上だとかというのも指定できます。細かい移動はカーソルでおこないます。
横･縦の順で指定します。
x_pos = Val(InputBox("図形の横位置を入力してください。全体を20分割　0-20　", , , 10))
y_pos = Val(InputBox("図形の縦位置を入力してください。全体を20分割　0-20　", , , 10))

　4.グラフ上で図形を描き、あわせて指定した場所に移動する。
　　図形の種類は面取り長方形としています。種類を増やす場合はここを拡充してください。"図形の複数一括作成"をサブルーチン化するといいと思います。問題点は確かめていませんので、各自で行なってください。エラー回避を忘れずに。
　　複数の可能性がありますので、For文で囲ってください。
　 ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 225.75, 822.75, 126#, 62.25).Select
　テキストの書き込みです。
Selection.Characters.Text = mm1(i)
　位置の指定は次のようにします。"ll"が付いたものは定数と見てください。
　const文での定義を忘れずに。
Selection.Left = ll060 + ll026 * x_pos + (i - 1) * ll026 / 2
Selection.Top = ll030 + ll016 * y_pos + (i - 1) * ll016 / 2

　最後に、プロットエリアを指定して終わります。これがなくても支障はありませんが、最後に移動した図形がアクティブになっています。後の処理にどちらが便利かです。
ActiveChart.PlotArea.Select

　このシステムの機能としてほかに必要なのは、
　・テキストの取得･書き出し(ワークシートから及びへ)
　・テキスト(コメント)の修正
　・図形(ひとつ)の移動
　です。
　他の拡張機能は、図形システムから移植してみてくさい。
　色の選択、図形の削除などは、セル参照をしています(※)が、基本的にはセルを必要していません。エラー回避さえすれば、そのまま使えます。
　※最後に焦点をセルに移すため、最初にカーソルがあったセルをアクティブにしている。

　おしまい。

第74回目 図をもとに説明するためのツール

○第74回目　図を加えて説明するためのツール


　これまでの説明はほとんど文章だけで、イメージがつきづらいという問題がありました。
　少しでも図式を取り入れて説明するということも必要ですので、いろいろと探していたところ、便利なツールが見つかりました。
　これを使って、図を登場させたいと思います(投稿時期のずれのため、これまでの投稿にはすでに一部対応しています)。

【図形作成システムで作成した例】










　ホームページからの転載です。
　　http://www2s.biglobe.ne.jp/~iryo/2vba/vba29b.htmlより転載。
---------------------------------------------------------------------------
２９－３６．シ－ト上の指定したセルをgif(jpg)で保存
○●● ホ－ムペ－ジを出していると説明用に、シ－トの特定セルを切り取り図形(gif) で保存したいケ－スがよくあります。簡単に変換する方法がないか色々考えようやく出来たのが下記マクロです。（本人評価→スゴク便利）

マクロの説明：
[1]開いているブックと同じフォルダ－へ保存します。(新規作成のブックは一度保存すること）
[2]変換したいセルの場所はマウスで範囲を指定（InputBoxメソッドのType:=8使用）
[3]指定した範囲を図でコピ－（Format:=xlBitmapがピクチャ－より綺麗だった）
[4]図の大きさを取得し、それより少し大きいChart枠を作成[3]を貼り付け
[5]Exportメソッドでgifファイルとして保存（ファイル名は"Mygif.gif"としてある）
[6]上記で仮作成した、図とチャ－トを削除


Sub 例2936()
Dim grf As Chart
Dim scel As Range

'保存先パス
phn = ActiveWorkbook.Path
If phn = "" Then
MsgBox "このブックと同じフォルダ－へGIFを保存します" & Chr(10) _
& "パス未定の為ブックを1度保存してから実行して下さい"
Exit Sub
End If

'コピ－個所指定
msg = "GIFで保存するセル範囲を指定して下さい。" & Chr(10) _
& "(セル範囲をシ－トから指定して下さい)"
On Error Resume Next
Application.DisplayAlerts = False
Set scel = Application.InputBox(msg, "セル指定", Type:=8)
Application.DisplayAlerts = True
If TypeName(scel) = "Nothing" Then
MsgBox "セル範囲をシ－トから指定して下さい"
Exit Sub
End If
On Error GoTo 0
scel.Select
'画像コピ－
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ActiveSheet.Paste
ActiveSheet.Pictures.Select
pnam2 = Selection.Name

ActiveSheet.Shapes(pnam2).Select
hei = Selection.ShapeRange.Height
wid = Selection.ShapeRange.Width
'チャ－ト枠作成
Set grf = ActiveSheet.ChartObjects.Add(0, 0, wid + 8, hei + 8).Chart
grf.Paste

'gif保存
grf.Export phn & "\" & "Mygif.gif"
'仮作成の図形削除
grf.Parent.Delete
ActiveSheet.Shapes(pnam2).Select
Selection.Delete

Range("A1").Select
End Sub

jpg保存の場合は、grf.Export phn & "\" & "Mygif.gif"を"Mygif.jpg"にして下さい

--以上、http://www2s.biglobe.ne.jp/~iryo/2vba/vba29b.htmlより転載。---------

○第73回目　図形編(その11)　画像の貼付け

　エクセルに画像を張り付ける。大変そうな気がしますが、割合簡単です。
　与える情報は、画像のあるパス名と張り付ける場所ぐらいなもんです。
　ただし、画像は大きさが大きいので、縮小して表示することにします。(サイズの変更でも可能です)
　セルにパス名を入れて置きそのセルを指定(複数可)してから実行です。
　サイズは無条件に4分の1とします。
　並べる位置を与えて多少間隔をあけて斜めに並べます。
　同じマクロで追加処理も可能です。

　手順です。
　1.指定範囲の取得とパラメータの取得
　2.画像の貼付け。同時に大きさを取得し大きさを縮小する
　3.貼り付ける位置の指定
　4.画像の整列

　1.は定番ですね。パス名は path_name(100) としました。

2.画像の貼付けです
ActiveSheet.Pictures.Insert(path_name(i)).Select

2-2.大きさの縮小です
hig = Selection.ShapeRange.Height
wid = Selection.ShapeRange.Width
hig2 = Int((hig * ll025 / 100) * 4 + 0.5) / 4　　'll025は25のこと
wid2 = Int((wid * ll025 / 100) * 4 + 0.5) / 4
Selection.ShapeRange.Height = hig2
Selection.ShapeRange.Width = wid2
　※これをFor文で囲ってください。

　3.貼付け先のセル範囲の設定。これもほとんど定番化しています。
Dim セル範囲 As Range
Range(AAA1).Select
Set セル範囲 = Application.InputBox(Prompt:="図形を並べる基準のセルを指定してください", Default:=AAA1, Left:=10, Top:=2, Type:=8)
　 aaa2 = セル範囲.Address
　retu2 = Range(aaa2).Column
　 gyo2 = Range(aaa2).Row

　4.画像の整列
　　6行、3列ずらしで整列しています。
j = ii9 + i
ActiveSheet.Shapes(j).Left = Cells(gyo2 + (i - 1) * ll006, retu2 + (i - 1) * ll003).Left　　　'll006は6のこと
ActiveSheet.Shapes(j).Top = Cells(gyo2 + (i - 1) * ll006, retu2 + (i - 1) * ll003).Top
　※これをFor文で囲ってください。
※最初の段階で既存の図形数を取得しておいてください。
ii9 = ActiveSheet.Shapes.Count

【画像の貼付結果とパス名】








　写真入りのレポートなどに使えますね。
　説明文は…。いろいろまだ問題があります。
　エクセルでは、ワードレベルのものが表せません。行間、文字間、文章の連続性などが弱いのです。

第72回目 図形編(その10) 図形にかかる補助機能の番外と思いましたが…

○第72回目　図形編(その10)　図形にかかる補助機能の番外と思いましたが…


　第72回目は、"図形にかかる補助機能の番外"でもやろうかと思っていましたが、図形のテーマでの話が長くなってしまったので、その他機能の紹介はこれで打ち切りにします。
　今回は、じゃあどんな事例に活用できるのかということをまとめてみます。
【一般的な手順】《　》内はマクロ
　1.テキストをセルに書き込む。
　2.テキストの範囲を指定して図を作成。《図形の複数一括作成》
　　図形の種類が異なる場合は複数にわけで作成します。
　3.テキストを取得しセルに書き込みます。《図形のテキストの取得_書き込み》
　　位置を記入する場所を確保されます。"図形関係のパラメータ設置エリア"を作ってそこで管理するといいです。
　4.図のテキストに図番号を追加する。《図形のテキストに図形の番号を追加_削除》
　5.位置を決める。A1座標で与えますので、"位置決めのツール"を使ってもいいし、適当に決めてもいいです。数が多いときは"位置決めツール"がいいと思います。図形の移動_場所を指定する》
　7.関連する図形をコネクタで結ぶ。その後で3.も行ないます《図形をコネクタで結ぶ》
　8.サイズの変更、図形に色を塗る。《図形のサイズの変更》《図形_色の選択》
　9.図を追加する。2.で出来ます。その後で3.も行ないます
　10.不要な図を削除する。その後で3.も行ないます《図形の削除》
　(注)図番号とは、図の上下の位置関係を表したものだったんです。番号を大きなものを小さなものに重ねると、小さい番号の図が隠れてしまいます。図番号とは、重ねた時の上下の位置関係を示すものです。したがって、図形の順序(最背面へなど)を変えてしまいますと図番号が変わってきてしまいます。4.を二回動かして、図形番号の表示を更新してください。また、"図形関係のパラメータ設置エリア"などのテキストをクリアして、3.も合わせて行ってください。

　参考に、現時点におけるメインのマクロからの枝分けを載せておきます。
　'処理区分の入力。
　　kubun = InputBox("処理区分を入れてください。" & vbCrLf & _
　　"１=⇒図形の複数一括作成" & vbCrLf & _
　　"２=⇒図形のテキストの取得_書き込み" & vbCrLf & _
　　"３=⇒図形のテキストの修正" & vbCrLf & _
　　"４=⇒図形をコネクタで結ぶ" & vbCrLf & _
　　"５=⇒図形の移動_整列もどき" & vbCrLf & _
　　"６=⇒図形のサイズの変更" & vbCrLf & _
　　"７=⇒図形の移動_場所を指定する" & vbCrLf & _
　　"８=⇒指定した一つの図形の移動" & vbCrLf & _
　　"９=⇒図形のテキストに図形の番号を追加_削除" & vbCrLf & _
　　"１０=⇒図形の削除" & vbCrLf & _
　　"１１=⇒コネクタの削除" & vbCrLf & _
　　"１２=⇒ライン_コネクタの修飾" & vbCrLf & _　　　'太さ、矢印の向き
　　"１３=⇒色の選択" & vbCrLf & _
　　"１４=⇒図形の順序" & vbCrLf & _
　　"１５=⇒図形の外枠の設定_消去" & vbCrLf & _
　　"　" & vbCrLf _
　　, xpos:=2000, ypos:=3000, Default:=1)

　上のサブルーチン一覧(作成例なので11個に限定した)を、このシステムを使って図で表してみました。また、全体を"図形の作成"として囲みました。全体としての縦長の一つの島の上に、11個のサブの図形がのっかっているというイメージです。色づけもしました。

　テキストは正味のものとして用意されている段階から行なうと、時間的には、どうでしょうか…。
　今までのマウス主体のやり方と比べると、4分の1以下の時間でできたような気がします。その理由は、11個のサブの図形が一括して処理できるので、1個1個の処理とか、全体を指定しての処理とかが早くできるからです。
　ここでいうサブの数が多ければ多いほど差が大きくなっていくでしょう。
　あと大切なことは、疲れないということです。
　なお、"8.サイズの変更"については、見当がつかない場合とか微妙な場合などは手作業のほうがいいと思いました(1回手作業で行いました)。

　※前回問題提起した、ActiveSheet..Shapes.Range(Array(1, 2, 3)) …にかかる記述の冗長性の問題については、解決しました。論理的な文一つで記述することが出来ました。その前に若干のおまじないはしましたが…。
　前回問題を提起したところ、アイデアがひらめきました。違う感覚で見てみるのも大切ですね。
'整列対象の図形の設定
　　ActiveSheet.Shapes.Range(Array( _
　　nn(0), nn(1), nn(2), nn(3), nn(4), nn(5), nn(6), nn(7), nn(8), nn(9) _
　　, nn(10), nn(11), nn(12), nn(13), nn(14), nn(15), nn(16), nn(17), nn(18), nn(19) _
　　, nn(20), nn(21), nn(22), nn(23), nn(24), nn(25), nn(26), nn(27), nn(28), nn(29) _
　《中略》
　　, nn(80), nn(81), nn(82), nn(83), nn(84), nn(85), nn(86), nn(87), nn(88), nn(89) _
　　, nn(90), nn(91), nn(92), nn(93), nn(94), nn(95), nn(96), nn(97), nn(98), nn(99) _
　　)).Select
　100個まで可能としました。論理的には一文です。
　そして、おまじないとは、
　z_no = no9 - no1 + 1
　j = no1
　For i = 0 To ll099
　　nn(i) = j + (i Mod z_no)
　Next i
　nn(i) に処理対象となる図形番号を、繰り返し入れていくのです。
　(この方法でも問題があることが後ほどわかりました。十分にデバックをしていませんでした)

第71回目 図形編(その9) 図形の整列

○第71回目　図形編(その9)　図形の整列
　※マクロはエクセル2007でのものです。2003でも動きました。

　これまでよく簡単極まりないといっていますが、今回は何が難しいのですか。
＝⇒整列のコマンドは簡単なのですが、基本的なところが違うのです。今までは、複数の図形を対象としていますが、いって見れば、他の図形との関係はまったくありません。他の図形と独立なのです。しかし、今回の場合は、他の図形の情報が必要なのです。一遍で関連する図形を指定しなければなりません。図形の数がいつも変わってしまい、図形の指定の命令文も変わってしまうということです。
　今、処理できるのは、ある特定の条件に絞られてしまいます。その範囲を広げれば広げるほど、冗長的に命令文が増えてしまうのです。
　例えば、普通のワークシート上で、繋がっていない複数の範囲を指定する場合は、Ctrlを押しながらクリックします。するとマクロはどうなるというと、
　"Range("A1:C3,B5:D7,…").Select"　というようになります。
　カッコの中が増えていくのです。
　これを文字列としてつくり(変数化する)、カッコの中に入れてやれば、うまくいくと思ったのですが、エラーになりこの手が使えないのです。
　ActiveSheet.Shapes.Range(Array("角丸四角形 186", "角丸四角形 187", "角丸四角形 188", "角丸四角形 189", "角丸四角形 190")).Select
とか
　ActiveSheet..Shapes.Range(Array(1, 2, 3)) …
　と記述する必要があるのですが、カッコ内の文字列が出来ないのです。
　後者の例で、単純に、a="1, 2, 3"として、…Array(a)…とするとエラーになってしまうのです。また、(z_no(1),z_no(2),z_no(3),z_no(4),z_no(5),z_no(6),z_no(7))として、有効数以降はヌルをいれるという手もエラーになってしまいます。
　ということで、二つの場合は、三つの場合は、四つの場合は、…と、それぞれの場合を記述していかなければならないのです。そのために冗長的になってしまうのです。
　と書いたところであるアイデアが生まれました。
　この手で、冗長さを解消できるかどうかやって見ます。その結果は、次回に。
　今回は冗長的なものを紹介します。

　1.対象とする図形の範囲を入力する
　2.処理区分を入力する
　3.整列処理の前処理
　4.整列処理

　1.はいつものように省略です。本当によく使われますね。

　2.
　　kubun = InputBox("処理区分を入力してください。　" & vbCrLf & _
　　"１=⇒水平に整列" & vbCrLf & _
　　"２=⇒垂直に整列" & vbCrLf & _
　　"３=⇒水平に均等配置" & vbCrLf & _
　　"４=⇒垂直に均等配置" & vbCrLf & _
　　"　" & vbCrLf _
　　, xpos:=2000, ypos:=3000, Default:=1)

　処理区分1と3の違いは何ですか？
＝⇒1.は横軸が統一されます。横一線になります。しかし、横の位置は変わりません。すなわち、垂直の位置だけが統一されるということです。
　　3.は横一線にはなりませんが、横の位置が均等化されるのです。すなわち、垂直の位置は変わらないのですが、水平の位置が均等な間隔に配置されるのです。
　　二つを掛け合わせれば、均整のとれた横一線ということになります。

【原図】








【"水平に整列"の処理後】








【"水平に均等配置"の処理後】








　3.整列させる図形範囲の記述
　j = no1
　z_no = no9 - no1 + 1
　Select Case z_no
'1
　Case 1
　　ActiveSheet.Shapes.Range(Array(j)).Select
'2
　Case 2
　　ActiveSheet.Shapes.Range(Array(j, j + 1)).Select
'3
　Case 3
　　ActiveSheet.Shapes.Range(Array(j, j + 1, j + 2)).Select
　:
　というように、続けていきます。これが冗長的の正体です。
　現時点では最大10個までの記述としています。これを増やしていけば、100個でも可能です。が、気持ちが悪いのです。

　4.図形の整列
　これは単純です(文末のFalseの意味はわかりません)。
Select Case kubun
'水平に整列
　Case "1"
　　Selection.ShapeRange.Align msoAlignMiddles, False
'垂直に整列
　Case "2"
　　Selection.ShapeRange.Align msoAlignCenters, False
'水平に均等配置
　Case "3"
　　Selection.ShapeRange.Distribute msoDistributeHorizontally, False
'垂直に均等配置
　Case "4"
　　Selection.ShapeRange.Distribute msoDistributeVertically, False
　Case Else
　　Exit Sub
End Select

　おしまい。