エクセルアドインの午後のパレットの午後の
見出し付きテキストボックスは複数の図形をグループ化しているだけ
レイアウトの崩れてしまったのを右の状態にするボタン
再調整画像付きTB
選択された図形を再調整する
これの動きのメモ
サイズの調整をしてから位置の調整をしている
サイズ調整は
見出しと本文の図形の幅を画像に合わせる
高さは文字に合わせる
位置の調整は
基準が見出し図形にして
画像図形を見出しの下側
本文を画像図形の下側
これには選択された図形が何の図形なのかを取得する必要がある
見出し図形なのか、本文用のテキストボックスなのかとか
これが難しかったのでメモしておこうかと
もっといい方法がありそうだけど思いつかない
グループ化された図形の選択状態は2種類ある
AとBと区別すると
名前のところが「グループ化 339」になっている
これがA
名前のところが「正方形/長方形 340」になっている
これがB
名前のところが「図 342」になっている
これもB
グループ化図形の中の1つの図形を選択しているBの違い
B状態は特殊で1つのグループ化図形を選択している時だけで
複数のグループ化図形を選択している状態では発生しない
こういう状況はありえない
複数図形を選択しているのにグループ化図形の中の1つの図形を選択した状態
左がB状態で右がA状態って言うことになはらない
必ずこうなる
A状態の選択が2つになる
図形のいろいろな選択状態(Selection.ShapeRangeの中)を見てみる
Sub testShape()
Dim SR As ShapeRange
Set SR = Selection.ShapeRange
End Sub
図形を選択した状態で↑を実行して一時停止して
SRの中身を見てみる
ローカルウィンドウの表示方法
一個の四角形図形を選択した状態
グループ化図形ではないのでグループ化に関係するところの値は
GroupItemsがこのメンバにアクセスできるの～ParentGroupが指定された値は境界を超えて～
とかまともな値が入っていないのがわかる
TypeがmsoAutoShape
グループ化図形を選択した状態
ParentGroupはさっきと同じでエラーみたいになっている
TypeはmsoGroupになっている、この図形はグループ化図形ですってことかな
GroupItemsの中身を見てみる
Item1の中身を見てみる
図形
3つは見出しと本文と画像の3つの図形ってことみたい
グループ化図形の中の本文用図形のテキストボックスを選択した状態
GroupItemsはエラーみたいになっている
TypeはTextBoxになっている
ParentGroupはなにか値が入っているので中身を見てみる
Nameもグループ化 339ってなっている
ここまでまとめると
簡単に見分けることができるのはグループ化図形そのままの時で
これはType＝msoGroupで判定できる
問題は単独図形なのかグループ化図形の中の1つなのかの判断
ParentGroupになにか値が入っているなら
グループ化図形の中の1つってことになるけど
この判定の仕方がわからない
例えば
Sub testShape()
Dim SR As ShapeRange
Set SR = Selection.ShapeRange
If IsError(SR.ParentGroup) Then’エラーの判定
'処理
End If
If SR.ParentGroup Is Nothing Then ’空っぽの判定
'処理
End If
End Sub
エラーの判定と空っぽの判定どちらもエラーになる
指定された値は境界を超えていますはエラーでも空っぽでもないってことみたい
そうなんだろうけど、でもどうやって判定すればいいかわからないので
エラーになるならエラーになったら単独図形で
エラーにならなかったらグループ化図形の中の1つ
って判定することにした
複数の図形が選択されている場合
TypeはmsoShapeTypeMixedってのになっているなあ、これは気にしてない
複数の図形が選択されている場合の特徴は
Countが2以上の数値になっているのと
その数値分のItemがあること
なのでSelection.ShapeRange.Countが2以上なら
複数の図形が選択されているって判定できる
あとはそれぞれの図形の種類の判定
単独図形なら見出しの図形ってことになるからそれ以外の
見出し付きテキストボックスと画像付き見出し付きテキストボックス
この2つの中の図形をそれぞれ判定することになる
中を見てみる
Sub testShape()
Dim SR As ShapeRange
Set SR = Selection.ShapeRange
Dim GP1 As GroupShapes, GP2 As GroupShapes
Set GP1 = SR.Item(1).GroupItems
Set GP2 = SR.Item(2).GroupItems
End Sub
GroupShapesっていうクラス？型？を使って
ShapeRange.Item(n).GroupItemsでそれぞれのグループ化図形を取得している少し広げてみると
2個めのGroupItemsの中にはItemが3つ
あるのがわかる
GP1のItem1のTypeはmsoAutoShape
Item2のTypeはmsoTextBox
実際にGP1.Item(1).Typeの値を取得するとmsoAutoShapeじゃなくて
数値の1になってる、これだとわかりにくいので
わかりやすくRectangleっていう文字列が返ってきた
テキストボックスも17っていう数字じゃなくて文字列のTextBox
このDrawingObjectってのが便利だけどよくわからなくて
これで図形の取得や判別はできたので後は順番にサイズと位置を変更するだけ
デザイン画面
名前をつけるのがめんどくさくなってそのままの名前になっている
このボタンのクリックイベントに
Private Sub CommandButton7_Click()
Call ReAjustAllShape選択図形すべての位置とサイズを再調整
End Sub
'ボタンのクリックイベントにくっつける
Sub ReAjustAllShape選択図形すべての位置とサイズを再調整()
'選択された図形を取得、グループ化された図形の場合は分解して配列に入れた状態で取得
'配列の順番は0＝見出し、1=本文(テキストボックス)、2=画像
On Error Resume Next
Dim SR As ShapeRange
Dim SS() As Shape
Set SR = Selection.ShapeRange
If SR.Count = 1 Then
'選択図形が一個の場合(完全単独か1つのグループ化の中の一つの図形を選択した状態)
SS = GetShapes特殊選択状態(SR.Item(1))
'処理
Call ReAjust図形タイプごとに位置とサイズを再調整(SS)
Else
'複数図形が選択されている場合
Dim i As Long
For i = 1 To SR.Count
If SR.Item(i).Type = msoGroup Then
'グループ化された図形の場合
SS = GetShapesグループ化図形の中の図形を配列で取得(SR.Item(i).GroupItems)
Else
'単独図形の場合
ReDim SS(0)
Set SS(0) = SR.Item(i)
End If
'処理
Call ReAjust図形タイプごとに位置とサイズを再調整(SS)
Next
End If
End Sub
フォームモジュールに書いても同じだけど
このへんから標準モジュールに書いているんだなあ
書いてあるのは選択された画像を順番に取得して
図形のサイズと位置を再調整するプロシージャに投げている( ´∀｀)つ ミ
Function GetShapes特殊選択状態(CS As Shape) As Shape()
Dim SS() As Shape
Dim GP As GroupShapes
'渡されたshapeがグループ化図形か単独図形なのかを判断するのに
'エラーを使っている
'GroupShapesの変数に入れようとしてエラーになれば単独図形と判断して
'エラーが起きたらmyErrに飛ぶ
If CS.Type <> msoGroup Then
On Error GoTo myErr
'ParentGroupがあるグループ化の中のどれか1つの図形選択状態
Set GP = CS.ParentGroup.GroupItems
ElseIf CS.Type = msoGroup Then
'1つのグループ化された図形選択状態
Set GP = CS.GroupItems
Else
myErr:
'ParentGroupがない単独図形
ReDim SS(0)
Set SS(0) = CS
End If
If Not GP Is Nothing Then
'グループ化された図形の場合、順番を揃えて配列に入れる
SS = GetShapesグループ化図形の中の図形を配列で取得(GP)
End If
Err.Clear
GetShapes特殊選択状態 = SS
End Function
グループ化図形の中の1つの図形なのか
単独図形なのかの判定
方法を思いつかないのでエラーで判定しているところ
Function GetShapes特殊選択状態(CS As Shape) As Shape()
Dim SS() As Shape
Dim GP As GroupShapes
'渡されたshapeがグループ化図形か単独図形なのかを判断するのに
'エラーを使っている
'GroupShapesの変数に入れようとしてエラーになれば単独図形と判断して
'エラーが起きたらmyErrに飛ぶ
If CS.Type <> msoGroup Then
On Error GoTo myErr
'ParentGroupがあるグループ化の中のどれか1つの図形選択状態
Set GP = CS.ParentGroup.GroupItems
ElseIf CS.Type = msoGroup Then
'1つのグループ化された図形選択状態
Set GP = CS.GroupItems
Else
myErr:
'ParentGroupがない単独図形
ReDim SS(0)
Set SS(0) = CS
End If
If Not GP Is Nothing Then
'グループ化された図形の場合、順番を揃えて配列に入れる
SS = GetShapesグループ化図形の中の図形を配列で取得(GP)
End If
Err.Clear
GetShapes特殊選択状態 = SS
End Function
0＝見出し、1=本文、2=画像の順番に配列に入れて返している
Sub ReAjust図形タイプごとに位置とサイズを再調整(SS() As Shape, Optional FitTBHeight As Boolean = False)
'FitTBHeight=Trueでテキストボックスの高さをセルのグリッドに合わせる
'Midaが見出しの図形、TBがテキストボックス,Picが画像図形
'それぞれの図形のの位置とサイズを再調整
Dim Mida As Shape, TB As Shape, Pic As Shape
Select Case UBound(SS)
Case 0
'見出しだけの時
Set Mida = SS(0)
'処理、特にやること無い？
Case 1
'見出しとテキストボックスのとき
Set Mida = SS(0)
Set TB = SS(1)
Call ReadjustSub位置合わせ(SS(0), SS(1))
If FitTBHeight Then
Call FitHeightToCell図形の高さをセルグリッドに合わせる(SS(1))
End If
Case 2
'見出しとテキストボックスと画像のとき
Set Mida = SS(0)
Set TB = SS(1)
Set Pic = SS(2)
Call Adjust見出しとテキストボックスと画像の位置調整(SS(0), SS(1), SS(2))
If FitTBHeight Then
Call FitHeightToCell図形の高さをセルグリッドに合わせる(SS(1))
End If
End Select
End Sub
プロシージャに投げている
図形の数が1なら見出しだけ、2こなら見出し付きテキストボックス
3個なら画像付き見出し付きテキストボックス
って判定している
Public Sub ReadjustSub位置合わせ(myShape As Shape, myTB As Shape, _
Optional fitCell As Boolean = False, _
Optional fitHeight As Boolean = False)
Dim myTop As Single
'見出し用の図形をセルに合わせてから本文のテキストボックスを見出しにあわせる
If fitCell Then
Call FitShapes2Cell図形位置を最寄りのセルにピッタリ(myShape)
End If
myTop = myShape.Top
myShape.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
myShape.Top = myTop
With myTB
.Width = myShape.Width
.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
.TextFrame2.VerticalAnchor = msoAnchorTop
.Top = myShape.Top + myShape.Height
.Left = myShape.Left
'テキストボックスの高さの再調整してセルに合わせる
If fitHeight Then
Dim cellH As Single, TBH As Single
cellH = .BottomRightCell.Top + .BottomRightCell.Height
TBH = .Top + .Height
.TextFrame2.VerticalAnchor = msoAnchorMiddle '縦位置中央
.Height = .Height + (cellH - TBH)
End If
End With
End Sub
Sub Adjust見出しとテキストボックスと画像の位置調整(Mida As Shape, TB As Shape, Pic As Shape)
'渡されたテキストボックスと見出しと画像の位置を再調整
With Mida
.Width = Pic.Width
.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
Pic.Left = .Left
If .Fill.Transparency = 0 Then
'見出しの背景色が完全不透明なら
Pic.Top = .Top + .Height
Else
Pic.Top = .Top
End If
End With
With Pic
TB.Width = .Width
TB.Top = .Top + .Height
TB.Left = .Left
TB.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
End With
End Sub
Sub FitHeightToCell図形の高さをセルグリッドに合わせる(S As Shape)
'渡された図形の高さをセルグリッドに合わせる
'テキストの縦の表示位置は中央に変更
Dim cellH As Single
Dim SH As Single
With S
cellH = .BottomRightCell.Top + .BottomRightCell.Height
SH = .Top + .Height
.TextFrame2.VerticalAnchor = msoAnchorMiddle 'テキストの縦位置中央
.Height = .Height + (cellH - SH)
End With
End Sub
これでサイズと位置を再調整ボタンに関係するのは全部かな
やっぱりフローチャートあったほうがわかりやすいかなあ
今回の記事も文字が多いので全部書いてから投稿ボタンを押してエラーになって
書き直しが怖くて少し書いては投稿→記事の修正→少し書いては投稿をして書いた
これを繰り返している間は公開範囲設定を公開しないにして
書き終わったら全公開にして投稿
これなら変なエラーで記事を作りなおすことは避けられるけどめんどくさいｗ
ここまでで文字数は9500文字くらい
昨日はこれくらいでも投稿エラーになった