○第70回目 図形編(その8) 図形に色を塗る、コネクタを全部削除、図形の整列
※マクロはエクセル2007でのものです。
6.図形に色をつける
色の道は難しいと昔から言いますが、本当にそうです。いろいろありすぎてどこに焦点を定めたらいいのかわからないのです。ということで、色をパターン化することにします。
機械的には、どのくらいパターンがあるのかは不明です。突き止める気も起こりません。ただその一端を垣間見なければ進まないので垣間見てみることにします。
ワークシートに、1から64ぐらいまでの連番を縦に振ってください。
そして、その番号を指定して、"図形の一括作成"を動かしてみてください。図形の種類は面取り長方形です。これでは何も起こらないので、
この中に、次のコマンドを入れてください。
Selection.ShapeRange.Fill.ForeColor.SchemeColor = i
すると、図形を描いた後で、色が付加され、その後それらが表示されます。
それを見て、標準値にしたい色のパターンを選んでください。
筆者はパステルカラー系のものを選びました。
その番号を指定することが今回のメインです。
手順を記すと、
1.色をつける図形の範囲を入力する
2.色番号を入力する。これには透明度の指定も含めます
3-1.入力された色番号で指定の図形に色を塗ります。
3-2.指定された透明度を適用します
1.は、毎度おなじみの…なので、省略します。
2.は、(この色群はパステルカラー系です)
iro = InputBox("色番号を入力してください。 " & vbCrLf & _
"４０=⇒ 青色 " & vbCrLf & _
"４１=⇒ 水色 " & vbCrLf & _
"４２=⇒みどり " & vbCrLf & _
"４３=⇒黄色" & vbCrLf & _
"４４=⇒藍色 " & vbCrLf & _
"４５=⇒ピンク " & vbCrLf & _
"４６=⇒ムラサキ " & vbCrLf & _
"４７=⇒オレンジ " & vbCrLf & _
"１=⇒白 " & vbCrLf & _
"０=⇒透明 " & vbCrLf & _
" " & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=11)
'※通常の色系では、SchemeColor = 10 '赤、13 '黄色、11 '黄緑、9 '白
3-1、は、
ActiveSheet.Shapes(i).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = iro
※単純極まりません。
3-2.は、更に透明度の入力をし、その内容で処理します。透明度は100%透明は色なしです。
toumei_do = InputBox("透過度を入力してください。0-1.0 " & vbCrLf & _
" " & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=0.5)
透明にするのは、
ActiveSheet.Shapes(i).Select
Selection.ShapeRange.Fill.Transparency = toumei_do
です。
※これも単純極まりません。
7.コネクタを全部削除
これは今までのものの簡単な応用です。
もとのマクロは、"図形の削除"です。
図形の名前で、カギ型コネクタを判定するのは、"カギ型"になります。コネクタという名称では直線が含まれてしまいます。厳密にコネクタの役割をしたものを選ぶとなると難しいということになりますが、直線は単純な線という位置づけでいくと、"カギ型"という名称がポイントになります。
図形の名前を取得して、その中に、"カギ型"という文字が含まれている図形だけを削除することになります。
おしまい。
いろいろな試行錯誤の結果、現在では次のようにしています。
ActiveSheet.Shapes(i).Select
return_V1 = Selection.ShapeRange.Connector
If return_V1 = -1 And InStr(mm2(i), "直線コネクタ") = 0 Then
ActiveSheet.Shapes(i).Delete
' End If
End If
8.図形の整列(図形群の横軸をそろえる、縦軸をそろえる、横に均等配置する、縦に均等配置する)
これはうまくいきません。
処理対象となる図形をセットするところが難しいのです。
対応は次回以降。
2007年12月29日土曜日
2007年12月27日木曜日
第69回目 図形編(その7) 直線を引く、線の太さ･矢印
○第69回目 図形編(その7) 直線を引く、線の太さ･矢印
※マクロはエクセル2007でのものです。2003でも動きました。
4.直線を引く(水平、垂直線)
この機能は、図形の一括作成(第64回)の機能の中に、図形の種類の追加として付加します。
1.入力画面表示へ追加
2セレクト文の追加
対応は、次のようになります。
1.
z_form = InputBox("図計の種類を入れてください。" & vbCrLf & _
"１=⇒面とり長方形" & vbCrLf & _
"２=⇒楕円" & vbCrLf & _
"３=⇒爆発" & vbCrLf & _
"４=⇒吹き出し" & vbCrLf & _
"５=⇒直線(水平)" & vbCrLf & _
"６=⇒直線(垂直)" & vbCrLf & _
" " & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=1)
2.
Case "5" '直線(水平)
ActiveSheet.Shapes.AddLine(80.25, 840#, 309#, 840#).Select
Case "6" '直線(垂直)
ActiveSheet.Shapes.AddLine(82.5, 875.25, 82.5, 972#).Select
というような追加をしておけば、対応終了です。
ついでに、右向きの矢印の図形の必要な文も追加しておきます。
"７=⇒大きな矢印；右向き" & vbCrLf & _
Case "7"
ActiveSheet.Shapes.AddShape(msoShapeRightArrow, 231.75, 178.5, 73.5, 59.25).Select
おしまい。
5.線、コネクタの線の太さ、矢印の向きの修正
この処理は、図形の範囲を指定します。その中でライン関係のものだけ処理します。
1.対象とする図形の範囲を入力する
2.太さか矢印かの区分を入力する
3-1.太さの場合、線の幅を入力する。
3-2.矢印の場合、矢印の向き(なし、右向き、左向き、両方に矢印)を入力する。
4-1.太さの変更
4-2.矢印の向きの変更
1.は省略。
2.は
kubun = InputBox("処理区分を入れてください。" & vbCrLf & _
"１=⇒太さの指定" & vbCrLf & _
"２=⇒矢印の指定" & vbCrLf & _
" " & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=1)
※図形の数はどこかの段階で求めておいてください。
ii9 = ActiveSheet.Shapes.Count
同時に、図形の名前を取得します
For i = 1 To ii9
ActiveSheet.Shapes(i).Select
mm2(i) = Selection.Name
Next i
3-1.は、
'太さの入力
hutosa = InputBox("太さを入力してください。0.25単位で近いところにします ", , 2)
hutosa = Int((hutosa * 4 + 0.5)) / 4
4-1は、
図形の名前から、ラインまたはコネクタかどうかの判断し、ライン等の場合、太さを修正します。
'コネクタかどうか、ラインかどうか
return_V1 = Selection.ShapeRange.Connector
If (return_V1 = -1) Or InStr(mm2(i), "Line") <> 0 Then
Selection.ShapeRange.Line.Weight = hutosa
End If
3-2は、
muki = InputBox("矢印の向きを入力してください。" & vbCrLf & _
"０=⇒ なし" & vbCrLf & _
"１=⇒ 右へ ――→" & vbCrLf & _
"２=⇒ 左へ ←――" & vbCrLf & _
"３=⇒ 両方 ←―→" & vbCrLf & _
" " & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=1)
4-2は、
図形の名前から、ラインまたはコネクタかどうかの判断し、ライン等の場合矢印の向きを修正します。
'コネクタかどうか、ラインかどうか
return_V1 = Selection.ShapeRange.Connector
If (return_V1 = -1) Or InStr(mm2(i), "Line") <> 0 Then
Select Case muki
'なし
Case "0"
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadNone
' ――→
Case "1"
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
' ←――
Case "2"
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
' ←―→
Case "3"
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
Case Else
Exit Sub
End Select
End If
おしまい
※コマンドとして何を使うのかが核心です。
コマンドの意味は、見ていただけばわかると思います
長くなりましたので、"6.図形に色をつける"は次回に回します・
※マクロはエクセル2007でのものです。2003でも動きました。
4.直線を引く(水平、垂直線)
この機能は、図形の一括作成(第64回)の機能の中に、図形の種類の追加として付加します。
1.入力画面表示へ追加
2セレクト文の追加
対応は、次のようになります。
1.
z_form = InputBox("図計の種類を入れてください。" & vbCrLf & _
"１=⇒面とり長方形" & vbCrLf & _
"２=⇒楕円" & vbCrLf & _
"３=⇒爆発" & vbCrLf & _
"４=⇒吹き出し" & vbCrLf & _
"５=⇒直線(水平)" & vbCrLf & _
"６=⇒直線(垂直)" & vbCrLf & _
" " & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=1)
2.
Case "5" '直線(水平)
ActiveSheet.Shapes.AddLine(80.25, 840#, 309#, 840#).Select
Case "6" '直線(垂直)
ActiveSheet.Shapes.AddLine(82.5, 875.25, 82.5, 972#).Select
というような追加をしておけば、対応終了です。
ついでに、右向きの矢印の図形の必要な文も追加しておきます。
"７=⇒大きな矢印；右向き" & vbCrLf & _
Case "7"
ActiveSheet.Shapes.AddShape(msoShapeRightArrow, 231.75, 178.5, 73.5, 59.25).Select
おしまい。
5.線、コネクタの線の太さ、矢印の向きの修正
この処理は、図形の範囲を指定します。その中でライン関係のものだけ処理します。
1.対象とする図形の範囲を入力する
2.太さか矢印かの区分を入力する
3-1.太さの場合、線の幅を入力する。
3-2.矢印の場合、矢印の向き(なし、右向き、左向き、両方に矢印)を入力する。
4-1.太さの変更
4-2.矢印の向きの変更
1.は省略。
2.は
kubun = InputBox("処理区分を入れてください。" & vbCrLf & _
"１=⇒太さの指定" & vbCrLf & _
"２=⇒矢印の指定" & vbCrLf & _
" " & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=1)
※図形の数はどこかの段階で求めておいてください。
ii9 = ActiveSheet.Shapes.Count
同時に、図形の名前を取得します
For i = 1 To ii9
ActiveSheet.Shapes(i).Select
mm2(i) = Selection.Name
Next i
3-1.は、
'太さの入力
hutosa = InputBox("太さを入力してください。0.25単位で近いところにします ", , 2)
hutosa = Int((hutosa * 4 + 0.5)) / 4
4-1は、
図形の名前から、ラインまたはコネクタかどうかの判断し、ライン等の場合、太さを修正します。
'コネクタかどうか、ラインかどうか
return_V1 = Selection.ShapeRange.Connector
If (return_V1 = -1) Or InStr(mm2(i), "Line") <> 0 Then
Selection.ShapeRange.Line.Weight = hutosa
End If
3-2は、
muki = InputBox("矢印の向きを入力してください。" & vbCrLf & _
"０=⇒ なし" & vbCrLf & _
"１=⇒ 右へ ――→" & vbCrLf & _
"２=⇒ 左へ ←――" & vbCrLf & _
"３=⇒ 両方 ←―→" & vbCrLf & _
" " & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=1)
4-2は、
図形の名前から、ラインまたはコネクタかどうかの判断し、ライン等の場合矢印の向きを修正します。
'コネクタかどうか、ラインかどうか
return_V1 = Selection.ShapeRange.Connector
If (return_V1 = -1) Or InStr(mm2(i), "Line") <> 0 Then
Select Case muki
'なし
Case "0"
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadNone
' ――→
Case "1"
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
' ←――
Case "2"
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
' ←―→
Case "3"
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
Case Else
Exit Sub
End Select
End If
おしまい
※コマンドとして何を使うのかが核心です。
コマンドの意味は、見ていただけばわかると思います
長くなりましたので、"6.図形に色をつける"は次回に回します・
2007年12月22日土曜日
第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
です。
ほとんど既存のものを使いまわせますので、簡単に出来ます。
おしまい。
※マクロはエクセル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
です。
ほとんど既存のものを使いまわせますので、簡単に出来ます。
おしまい。
2007年12月19日水曜日
第67回目 図形編(その5) 図形と図形を結ぶ
○第67回目 図形編(その5) 図形と図形を結ぶ
今回はコネクタが出てきます。図形をつなぎ、連携関係を表すものです。
コネクタは、カギ型を使用します。直角が多く出るので図にキレが生じます。
コネクタで必要な条件は、どの図形とどの図形をどの場所でどの場所で結ぶかということです。パラメータは4つあります。
場所とは、大体は図形の上中央、左中央、下中央、右中央の4つです。
上の図形の下中央から、下の図形の上中央を結ぶ、という感じになります。
4つのセットを必要なだけ用意しておいて、これを読み込ませ、この条件でコネクタを引いてください、というのが、マクロの流れとなります。
0.事前に4項目(コネクタの元と先の図形番号とそれぞれのコネクタをつける場所。)のセットを作っておき、その場所を選択しておく。
1.パラメータを取得する
2.パラメータの内容に基づきコネクタを引く
1.は基本コマンドなので省略します。
コネクタ(カギ型です)を引くコマンドは次の通りです。
ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 283.5, 405#, 7.5, 48# _
).Select
コネクタの先を矢印型にする
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
線の太さ
Selection.ShapeRange.Line.Weight = 1.25
コネクタ開始の図形とその場所
Selection.ShapeRange.ConnectorFormat.BeginConnect ActiveSheet.Shapes(z_no1(i)), kone1(i)
Shapes(z_no1(i)) のカッコ内が図形の番号です
kone1(i) のカッコ内が結ぶ場所の番号です
コネクタ先の図形とその場所
Selection.ShapeRange.ConnectorFormat.EndConnect ActiveSheet.Shapes(z_no9(i)), kone9(i)
Shapes(z_no9(i)) のカッコ内が図形の番号です
kone9(i) のカッコ内が結ぶ場所の番号です
これを必要なだけ繰り返します。
このマクロのメリットは、机上で設計が出来、そのままパラメータとして与えられる点です。
一旦コネクタで結べば、もとの図形を動かしても大丈夫です。
それでは、コネクタを引きなおしたいというニーズに対してはどうするのでしょうか。
現在では、特定のコネクタを指定して、引き直すというやり方はとっていません。一旦削除(これはマクロ)して、改めて引き直すという方法をとっています。これはコネクタの図形番号がわかりにくいということによります。
具体的手順は次のようになります。
1.一旦引いた後、"図形のテキスト、名前等の取得・書き込み"(第65回目参照)で、コネクタ群の図形番号を把握します。
2.その番号を指定して、図形を削除します。(今後登場予定)
3.コネクタのパラメータを修正して、改めてコネクタを引きます。
今回までで、組織図とか流れ図などかなりの部分は作成可能となります(間違った場合はその部分を手で削除して作り直してください)。
エクセルシートを文書と見立てれば、ワード感覚の資料が出来ます。
次からは補助機能を紹介します。
1.今回話題になった削除(図形番号を指定。範囲指定も可とする)
2.図形のテキストに図形番号を付加するまたは図形番号を削除する
(図を見ただけで番号がわかるようにします。不要になれば消せます)
3.大きさの修正(倍率を指定。縦横同時のみならず、縦だけ、横だけも可とする)
4.直線を引く(水平、垂直線)
5.線、コネクタの線の太さ、矢印の向きの修正
6.図形に色をつける
7.コネクタを全部削除
もひとつおまけに、
8.図形の整列(図形群の横軸をそろえる、縦軸をそろえる、横に均等配置する、縦に均等配置する)
今回はコネクタが出てきます。図形をつなぎ、連携関係を表すものです。
コネクタは、カギ型を使用します。直角が多く出るので図にキレが生じます。
コネクタで必要な条件は、どの図形とどの図形をどの場所でどの場所で結ぶかということです。パラメータは4つあります。
場所とは、大体は図形の上中央、左中央、下中央、右中央の4つです。
上の図形の下中央から、下の図形の上中央を結ぶ、という感じになります。
4つのセットを必要なだけ用意しておいて、これを読み込ませ、この条件でコネクタを引いてください、というのが、マクロの流れとなります。
0.事前に4項目(コネクタの元と先の図形番号とそれぞれのコネクタをつける場所。)のセットを作っておき、その場所を選択しておく。
1.パラメータを取得する
2.パラメータの内容に基づきコネクタを引く
1.は基本コマンドなので省略します。
コネクタ(カギ型です)を引くコマンドは次の通りです。
ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 283.5, 405#, 7.5, 48# _
).Select
コネクタの先を矢印型にする
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
線の太さ
Selection.ShapeRange.Line.Weight = 1.25
コネクタ開始の図形とその場所
Selection.ShapeRange.ConnectorFormat.BeginConnect ActiveSheet.Shapes(z_no1(i)), kone1(i)
Shapes(z_no1(i)) のカッコ内が図形の番号です
kone1(i) のカッコ内が結ぶ場所の番号です
コネクタ先の図形とその場所
Selection.ShapeRange.ConnectorFormat.EndConnect ActiveSheet.Shapes(z_no9(i)), kone9(i)
Shapes(z_no9(i)) のカッコ内が図形の番号です
kone9(i) のカッコ内が結ぶ場所の番号です
これを必要なだけ繰り返します。
このマクロのメリットは、机上で設計が出来、そのままパラメータとして与えられる点です。
一旦コネクタで結べば、もとの図形を動かしても大丈夫です。
それでは、コネクタを引きなおしたいというニーズに対してはどうするのでしょうか。
現在では、特定のコネクタを指定して、引き直すというやり方はとっていません。一旦削除(これはマクロ)して、改めて引き直すという方法をとっています。これはコネクタの図形番号がわかりにくいということによります。
具体的手順は次のようになります。
1.一旦引いた後、"図形のテキスト、名前等の取得・書き込み"(第65回目参照)で、コネクタ群の図形番号を把握します。
2.その番号を指定して、図形を削除します。(今後登場予定)
3.コネクタのパラメータを修正して、改めてコネクタを引きます。
今回までで、組織図とか流れ図などかなりの部分は作成可能となります(間違った場合はその部分を手で削除して作り直してください)。
エクセルシートを文書と見立てれば、ワード感覚の資料が出来ます。
次からは補助機能を紹介します。
1.今回話題になった削除(図形番号を指定。範囲指定も可とする)
2.図形のテキストに図形番号を付加するまたは図形番号を削除する
(図を見ただけで番号がわかるようにします。不要になれば消せます)
3.大きさの修正(倍率を指定。縦横同時のみならず、縦だけ、横だけも可とする)
4.直線を引く(水平、垂直線)
5.線、コネクタの線の太さ、矢印の向きの修正
6.図形に色をつける
7.コネクタを全部削除
もひとつおまけに、
8.図形の整列(図形群の横軸をそろえる、縦軸をそろえる、横に均等配置する、縦に均等配置する)
2007年12月15日土曜日
第66回目 図形編(その4) 図形の移動
○第66回目 図形編(その4) 図形の移動
まずはお遊びです。
一つの図形をカーソルのある場所に移動します。
Sub bb指定した一つの図形の移動()
'移動先のセルを指定してから実行
'図形の番号の事前確認が必要
Dim z_no
Dim AAA,AAA1,gyo1,retu1
On Error Resume Next
'指定範囲の取得
AAA = Selection.Address
'図形の移動
z_no = Val(InputBox("図形の番号を入力してください。 ", "1"))
ActiveSheet.Shapes(z_no).Left = Range(AAA).Left
ActiveSheet.Shapes(z_no).Top = Range(AAA).Top
Range(AAA).Select
End Sub
かなめはお分かりでしょうか。
ActiveSheet.Shapes(z_no).Left = Range(AAA).Left
ActiveSheet.Shapes(z_no).Top = Range(AAA).Top
の2行です。そしてこれを一般化すればいいことになります。
これをある程度システム化しなればなりません。それが本当の問題となります。
列番号で考えて、最後に列記号に変換するという流れとします。(行も考え方は同じです)
前提がいっぱいあるのですが、その一つは、図形を表示したい場所のセルは列の幅、行の高さは一定とするということです。セルにあわせて図形を置くことになるので納得いくと思います。(セルの幅8.3、セルの高さ13.5としました)
図形管理表を参照しながらお読みください。(端数の欄は気にしないでください)
【位置決めの手順】
1.左上端の基準セルを決めます。例として27列の6行目(AA6)とします。
2.一単位のセルの数を決め、基準のセルから何単位右に置くかを決めます。
3.図形の列を考えた時、何セルごとに並べれば重ならないか、間隔が適当かを決めます。1単位4列としました。同様に行数も決めます。1単位8行としました。
4.2の横に補助単位を入れます。これは基準単位の半分の列数とします。それに微調整としての数値を入れます。本単位を定めるの列、補助単位を定める列に数値(それぞれa1、a2とします)を入れます。
5.すると最終的な列番号は、27+a1*4+a2*2 となります。行数も、6+8*b1+4*b2 となります。同じ列に並べたいものは同じ数値を入れてください。
6.出来あがった列番号と行番号を用いて、A1形式の座標を作ります。列記号の変換の逆になりますので、列記号と列番号の対応を求める昔の記事を見てください(列記号と列番号の対応のために処理は、第26回参照)。
(この際に、番号から列記号の変換機能を関数にしました。エクセルシート上でも参照可能です)。
7.&関数で列記号と行番号をくっつけます。
8.これを、図形番号の横にあいている場所に張り付けます。式で持っていってもかまいません。いらないところはヌル("")にしてください。
9.図形番号と移動先セル座標を指定して、マクロを動かします。
図形の番号と移動先のセルの番号がわかりましたので、一個のときと同じことを何回か繰り返せばいいことになります。
列の位置、行の位置を決めるための位置単位の基準値は変更することがありますので外からあてがっておいてください。
これは連続している任意の個数を動かすことが出来ます。もちろん1個でも可能です。
マクロを動かすと面白いように意図したところに整列します。当たり前ですが…。
でも最初に動いた時は、感動しました。こういう感動を大切にしましょう。
まずはお遊びです。
一つの図形をカーソルのある場所に移動します。
Sub bb指定した一つの図形の移動()
'移動先のセルを指定してから実行
'図形の番号の事前確認が必要
Dim z_no
Dim AAA,AAA1,gyo1,retu1
On Error Resume Next
'指定範囲の取得
AAA = Selection.Address
'図形の移動
z_no = Val(InputBox("図形の番号を入力してください。 ", "1"))
ActiveSheet.Shapes(z_no).Left = Range(AAA).Left
ActiveSheet.Shapes(z_no).Top = Range(AAA).Top
Range(AAA).Select
End Sub
かなめはお分かりでしょうか。
ActiveSheet.Shapes(z_no).Left = Range(AAA).Left
ActiveSheet.Shapes(z_no).Top = Range(AAA).Top
の2行です。そしてこれを一般化すればいいことになります。
これをある程度システム化しなればなりません。それが本当の問題となります。
列番号で考えて、最後に列記号に変換するという流れとします。(行も考え方は同じです)
前提がいっぱいあるのですが、その一つは、図形を表示したい場所のセルは列の幅、行の高さは一定とするということです。セルにあわせて図形を置くことになるので納得いくと思います。(セルの幅8.3、セルの高さ13.5としました)
図形管理表を参照しながらお読みください。(端数の欄は気にしないでください)
【位置決めの手順】
1.左上端の基準セルを決めます。例として27列の6行目(AA6)とします。
2.一単位のセルの数を決め、基準のセルから何単位右に置くかを決めます。
3.図形の列を考えた時、何セルごとに並べれば重ならないか、間隔が適当かを決めます。1単位4列としました。同様に行数も決めます。1単位8行としました。
4.2の横に補助単位を入れます。これは基準単位の半分の列数とします。それに微調整としての数値を入れます。本単位を定めるの列、補助単位を定める列に数値(それぞれa1、a2とします)を入れます。
5.すると最終的な列番号は、27+a1*4+a2*2 となります。行数も、6+8*b1+4*b2 となります。同じ列に並べたいものは同じ数値を入れてください。
6.出来あがった列番号と行番号を用いて、A1形式の座標を作ります。列記号の変換の逆になりますので、列記号と列番号の対応を求める昔の記事を見てください(列記号と列番号の対応のために処理は、第26回参照)。
(この際に、番号から列記号の変換機能を関数にしました。エクセルシート上でも参照可能です)。
7.&関数で列記号と行番号をくっつけます。
8.これを、図形番号の横にあいている場所に張り付けます。式で持っていってもかまいません。いらないところはヌル("")にしてください。
9.図形番号と移動先セル座標を指定して、マクロを動かします。
図形の番号と移動先のセルの番号がわかりましたので、一個のときと同じことを何回か繰り返せばいいことになります。
列の位置、行の位置を決めるための位置単位の基準値は変更することがありますので外からあてがっておいてください。
これは連続している任意の個数を動かすことが出来ます。もちろん1個でも可能です。
マクロを動かすと面白いように意図したところに整列します。当たり前ですが…。
でも最初に動いた時は、感動しました。こういう感動を大切にしましょう。
2007年12月10日月曜日
第65回目 図形編(その3) 図形のテキスト、名前等の取得・書き込みから修正
○第65回目 図形編(その3) 図形のテキスト、名前等の取得・書き込みから修正
今回は、作成した図形のテキスト、名前等を取得し、セルに表示します。
手作業による、削除があるので、番号が崩れてしまいますので、現在の図形の状態を表示するものです。
表示項目は、図形の番号、テキスト、図形の名前(この中に種類が含まれる)です。後のために、図形の番号、スペース(位置座標用)、テキスト、図形の名前の4項目を表示します。
実行前に、貼付ける位置の先頭にカーソルをおいてください。
まずはセルの位置を取得してください。
次に、図形の数は、ii9 = ActiveSheet.Shapes.Count となります。
図形のテキストと名前は、Selection.Characters.Textと Selection.Nameとなります。
テキスト、名前の取得は次のようになります
ActiveSheet.Shapes(i).Select
mm1(i) = Selection.Characters.Text
mm2(i) = Selection.Name
これでほとんどおしまいなのです。
あとは、図形の番号、テキスト、図形の名前を指定された場所に貼り付けるだけです。
ほとんどロジックがないので簡単です。
cells(gyou1,retu1)から貼り付けていきます。二列目は、座標用なので飛ばして貼り付けてください。
Cells(gyo1 + i, retu1) = i
Cells(gyo1 + i, retu1 + 2) = mm1(i)
Cells(gyo1 + i, retu1 + 3) = mm2(i)
といった具合です。
図形の管理用の表を同時に作っておきます。イメージは下の画像のとおりです。
【図形管理表のイメージ】
テキストの内容を修正するにはどうしたらよいでしょうか。セルに書き込んだテキストを修正します。そして、図形の番号と共にテキストを指定して修正をかけます。
三列N行を指定することになります。指定してから実行してください。
マクロは、指定範囲座標の取得から、内容の格納となります。1列、空列がありますので気をつけてください。変数はnn(i)、mm1(i)にいれておいてください。
図形の番号をnn(i)で指定して、mm1(i)でテキストを置き換えます。
大事な部分を抜き出すと、
j = nn(i)
ActiveSheet.Shapes(j).Select
Selection.Characters.Text = mm1(i)
となります。
1行目と2行目以降を合体されても結構です。
ActiveSheet.Shapes(nn(i)).Select
Selection.Characters.Text = mm1(i)
ですから、図形の管理表を直して、直した箇所を指定してマクロを動かす。ということになります。修正の必要のないものも、同じもので直すと考えれば、最初から最後の図形のテキストまで指定してもいいことになります。
こんなに簡単だったんですね。手作業で行なうのとは比べ物になりません。
前にも言いましたが、どこからかテキストの内容を持ってきて、エクセルのセルに貼付け、図形を作成するということが簡単に出来てしまいのです。修正も簡単ですね。
次は図形の移動です。
これも準備(座標の決めと入力)に比べたらマクロは非常に簡単です。
本当に好きなところに移動します。面白いですよ。
今回は、作成した図形のテキスト、名前等を取得し、セルに表示します。
手作業による、削除があるので、番号が崩れてしまいますので、現在の図形の状態を表示するものです。
表示項目は、図形の番号、テキスト、図形の名前(この中に種類が含まれる)です。後のために、図形の番号、スペース(位置座標用)、テキスト、図形の名前の4項目を表示します。
実行前に、貼付ける位置の先頭にカーソルをおいてください。
まずはセルの位置を取得してください。
次に、図形の数は、ii9 = ActiveSheet.Shapes.Count となります。
図形のテキストと名前は、Selection.Characters.Textと Selection.Nameとなります。
テキスト、名前の取得は次のようになります
ActiveSheet.Shapes(i).Select
mm1(i) = Selection.Characters.Text
mm2(i) = Selection.Name
これでほとんどおしまいなのです。
あとは、図形の番号、テキスト、図形の名前を指定された場所に貼り付けるだけです。
ほとんどロジックがないので簡単です。
cells(gyou1,retu1)から貼り付けていきます。二列目は、座標用なので飛ばして貼り付けてください。
Cells(gyo1 + i, retu1) = i
Cells(gyo1 + i, retu1 + 2) = mm1(i)
Cells(gyo1 + i, retu1 + 3) = mm2(i)
といった具合です。
図形の管理用の表を同時に作っておきます。イメージは下の画像のとおりです。
【図形管理表のイメージ】
テキストの内容を修正するにはどうしたらよいでしょうか。セルに書き込んだテキストを修正します。そして、図形の番号と共にテキストを指定して修正をかけます。
三列N行を指定することになります。指定してから実行してください。
マクロは、指定範囲座標の取得から、内容の格納となります。1列、空列がありますので気をつけてください。変数はnn(i)、mm1(i)にいれておいてください。
図形の番号をnn(i)で指定して、mm1(i)でテキストを置き換えます。
大事な部分を抜き出すと、
j = nn(i)
ActiveSheet.Shapes(j).Select
Selection.Characters.Text = mm1(i)
となります。
1行目と2行目以降を合体されても結構です。
ActiveSheet.Shapes(nn(i)).Select
Selection.Characters.Text = mm1(i)
ですから、図形の管理表を直して、直した箇所を指定してマクロを動かす。ということになります。修正の必要のないものも、同じもので直すと考えれば、最初から最後の図形のテキストまで指定してもいいことになります。
こんなに簡単だったんですね。手作業で行なうのとは比べ物になりません。
前にも言いましたが、どこからかテキストの内容を持ってきて、エクセルのセルに貼付け、図形を作成するということが簡単に出来てしまいのです。修正も簡単ですね。
次は図形の移動です。
これも準備(座標の決めと入力)に比べたらマクロは非常に簡単です。
本当に好きなところに移動します。面白いですよ。
2007年12月1日土曜日
第64回目 図形編(その2) 図形の一括作成
○第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 をいれて、エラーを回避するのも一法です。(共通注意事項。致命的なエラーの場合ははずして原因を突き止めてください)
最初は図形の一括作成です。図形の選択はマクロの中で行ないます。実行前処理としては、書き込みたいテキストを選択することになります。
セルにテキストの内容を書いてその範囲を指定します。
この部分をセルの範囲座標の取得と内容の取得という基本的な機能で処理します。
また、追加でもいいことになるので、既存の図形の数も取っておきます。＝⇒新規作成だけでなく追加機能も含んでいます。
図形の数は最大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 をいれて、エラーを回避するのも一法です。(共通注意事項。致命的なエラーの場合ははずして原因を突き止めてください)
登録:
コメント (Atom)
