アクティブコントロールの移動

質問

初めて質問させていただきます。

Excelのシート上、一定の枠内にあるテキストボックスの中で
アクティブコントロールを取得し
決まったボタンで別枠内に集合させる、と言った内容のことを行いたいです。
具体的にはＡさん、Ｂさん、Ｃさんとテキストボックスがあり
ＡさんＢさんが出勤でＣさんが休暇の場合
Ｃさんをアクティブコントロールとして取得し
休暇枠ボタンで
休暇枠に飛ばしたいです。

ご教授願えれば幸いです・

回答No.5

Mathmi

(前の回答より)

Sub ボタン()
　Dim i As Integer, j As Integer
　Dim NewGyoumu As Integer '変更先の業務番号
　Dim myShp
　Dim Bangou() As Integer '曜日番号、業務番号を受け取る配列。

　'何も選択されていなければ終了する。
　If VarType(Selection) <> vbObject Then
　　Exit Sub
　End If

　'ボタンの名前から業務番号を設定する。
　Select Case ActiveSheet.Buttons(Application.Caller).text
　　Case "業務1"
　　　NewGyoumu = 1
　　Case "業務2"
　　　NewGyoumu = 2
　　Case "業務3"
　　　NewGyoumu = 3
　　Case "業務4"
　　　NewGyoumu = 4
　End Select

　'枠や名札位置、名前一覧を読み込み
　Call 設定
　Call 名札取得

　'データ上の業務番号を変更
　For Each myShp In Selection.ShapeRange
　　For i = 1 To UBound(Nafuda)
　　　If myShp Is Nafuda(i).shp Then
　　　　Nafuda(i).Gyoumu = NewGyoumu
　　　End If
　　Next i
　Next myShp

　'名札の位置を変更
　For i = 1 To nYoubi
　　For j = 1 To nGyoumu
　　　Call 枠再描画(i, j)
　　Next j
　Next i
End Sub

Sub 名札取得()
'画面内のオートシェイプの内、枠に含まれているものを検索。
'先に枠の設定を読み込む必要がある。
　Dim n As Integer
　Dim Bangou() As Integer
　Dim myShp As Shape

　For Each myShp In wsHyouji.Shapes
　　Bangou = 名札検索(myShp)
　　If Bangou(1) <> -1 Then '枠に含まれていれば
　　　n = n + 1
　　　ReDim Preserve Nafuda(1 To n)
　　　Set Nafuda(n).shp = myShp
　　　Nafuda(n).Youbi = Bangou(1)
　　　Nafuda(n).Gyoumu = Bangou(2)
　　　Nafuda(n).Key = myShp.TextFrame.Characters.text
'　　　myShp.Width = 50
'　　　myShp.Height = 20.25
　　End If
　Next myShp
End Sub

Function 名札検索(ByRef myShp As Shape) As Integer()
'そのオートシェイプが、どの枠の中に含まれているかを返す。
'先に枠の設定を読み込む必要がある。
　Dim i As Integer, j As Integer
　Dim aryRtn(1 To 2) As Integer '戻り値用配列

　'テキストボックスでないなら、異常を返して終了
　If myShp.Type <> msoTextBox Then
　　GoTo CONTINUE
　End If

　'枠なら、異常を返して終了
　For i = 1 To nYoubi
　　For j = 1 To nGyoumu
　　　If myShp Is Waku(i, j).shp Then
　　　　GoTo CONTINUE
　　　End If
　　Next j
　Next i

　'どの枠に含まれているか
　For i = 1 To nYoubi
　　For j = 1 To nGyoumu
　　　If Waku(i, j).Top <= myShp.Top And myShp.Top <= Waku(i, j).Bottom And _
　　　 Waku(i, j).Left <= myShp.Left And myShp.Left <= Waku(i, j).Right Then
　　　　aryRtn(1) = i
　　　　aryRtn(2) = j
　　　　名札検索 = aryRtn
　　　　Exit Function
　　　End If
　　Next j
　Next i

CONTINUE:
　aryRtn(1) = -1
　名札検索 = aryRtn
End Function

Sub 枠再描画(ByRef bi As Integer, ByRef Gyou As Integer)
'bi曜日の業務Gyouの枠に含まれる名札を並び替える。
　Dim i As Integer, j As Integer, n As Integer, cnt As Integer
　Dim TargetNafuda() As NamePlate '作業対象である名札

　'名札一覧からその枠内の名札のみを抽出
　For i = 1 To UBound(Nafuda)
　　If Nafuda(i).Youbi = bi And Nafuda(i).Gyoumu = Gyou Then
　　　n = n + 1
　　　ReDim Preserve TargetNafuda(1 To n)
　　　TargetNafuda(n) = Nafuda(i)
　　End If
　Next i

　'その枠に名札が含まれていなければ終了
　If n = 0 Then
　　Exit Sub
　End If

　'抽出した名札を、名前の順番で並び替え
　cnt = 0
　For i = 0 To UBound(Namae)
　　For j = 1 To UBound(TargetNafuda)
　　　If Namae(i) = TargetNafuda(j).Key Then
　　　　cnt = cnt + 1
　　　　TargetNafuda(j).shp.Left = Waku(bi, Gyou).Left + NafudaWaku(cnt).X
　　　　TargetNafuda(j).shp.Top = Waku(bi, Gyou).Top + NafudaWaku(cnt).Y
　　　End If
　　Next j
　Next i
End Sub
******************************

＞色々な無理な要求を短期間で解決するよう依頼が上がってきます。
プログラムが分かっていない人だと「この程度簡単でしょ」って気持ちで投げてくる時があるので、大変だとは思いますが、頑張って下さい。
コードを書いたり読み解いたりしていると、確実にスキルアップしますので。

回答No.4

Mathmi

補足ありがとうございます。

各業務に対応する変更用のボタンがあるものとして、選択した名札を、同じ曜日で押したボタンの業務の枠に移動するコードを組んでみました。
（上手な人には「なんだこのスパゲッティコードは！」って怒られそうな程度の代物ですが）

適宜変更して貰う点としましては
・表示するシート:[設定]プロシージャの[Set wsHyouji]を変更してください。
・業務の数:[Const nGyoumu As Integer]を変更してください。
・曜日の数:[Const nYoubi As Integer]を変更してください。
・枠の位置:[設定]プロシージャの[Waku(i,j).Left]以下、Left/Top/Width/Heightを変更してください。
・枠内の名札の位置:[設定]プロシージャの[varX][varY]を変更してください。varXは各X座標、varYは各Y座標を現しています。
・人の名前:[設定]プロシージャの[Namae]を変更してください。枠内には、ここに入力されている順番で表示されます。
・業務名:[ボタン]プロシージャの[Select Case]内の選択を、シートの各ボタンの名前に変更してください。

コメントアウトされているコードは、オートシェイプの大きさを変更する為のものです。削除しても問題ありません。
・[名札取得]プロシージャは、全ての名札の大きさを設定した大きさに変更します。
・[設定]プロシージャの「名称から枠のオートシェイプを検索、座標を変更する。」以降の部分は、四角形等オートシェイプの枠があった場合、その大きさを変更します。手動で枠の名前を変更し、[varYoubi]及び[varGyoumu]を、変更したその名前に合わせて変更すると、設定した枠の大きさに合わせて変更されます。

名札を選択するのではなく、別の場所のデータに従って各名札を変更する場合は、各[Nafuda]のYoubi、Gyoumuを変更した後、[ボタン]プロシージャの「名札の位置を変更」以下のコードで再描画して下さい。

ボタンにより移動するのは名札だけなので、もし枠がオートシェイプだったとして、一緒に選択しても、名札だけが移動します（全部を休暇に移動したい時等）。

******************************
Option Explicit

Type Casing
　shp As Shape
　Left As Double '枠の左端座標
　Right As Double '枠の右端座標
　Top As Double '枠の上端の座標
　Bottom As Double '枠の下端の座標
　Width As Double '枠の幅
　Height As Double '枠の高さ
End Type

Type NamePlate
　shp As Shape 'その名札のオートシェイプ
　Youbi As Integer 'その名札の曜日番号
　Gyoumu As Integer 'その名札の業務番号
　Key As String 'その名札の名前
End Type

Type Point
　X As Double
　Y As Double
End Type

Const nYoubi As Integer = 5 '1週間の日数
Const nGyoumu As Integer = 4 '業務の種類の数
Const nNafuda As Integer = 3 '一つの枠内にある名札の最大数
Dim wsHyouji As Worksheet '表示するシート
Dim Waku() As Casing '各枠のオブジェクトや座標
Dim NafudaWaku() As Point 'テキストボックスの規定位置。各枠左上からテキストボックスの左上までの
Dim Nafuda() As NamePlate '全名札のデータ
Dim Namae As Variant '名前の一覧。Arrayで入力できるようVariantとする。

Sub 設定()
　Dim i As Integer, j As Integer, n As Integer, temp As Variant
　Dim varX As Variant, varY As Variant
　Dim myShp
　Dim varYoubi As Variant '枠を検索する為の曜日名
　Dim varGyoumu As Variant '枠を検索する為の業務名

　'表を表示するシートを設定
　Set wsHyouji = Worksheets("Sheet1")

　'枠の位置を設定
　ReDim Waku(1 To nYoubi, 1 To nGyoumu)
　For i = 1 To nYoubi
　　For j = 1 To nGyoumu
　　　Waku(i, j).Left = (j - 1) * 200 + 50
　　　Waku(i, j).Top = (i - 1) * 150 + 20
　　　Waku(i, j).Width = 150
　　　Waku(i, j).Height = 100
　　　Waku(i, j).Right = Waku(i, j).Left + Waku(i, j).Width
　　　Waku(i, j).Bottom = Waku(i, j).Top + Waku(i, j).Height
　　Next j
　Next i

　'枠内のテキストボックスの相対位置を設定
　ReDim NafudaWaku(1 To nNafuda)
　varX = Array(10, 10, 10)
　varY = Array(10, 40, 70)
　For i = 1 To nNafuda
　　NafudaWaku(i).X = varX(i - 1)
　　NafudaWaku(i).Y = varY(i - 1)
　Next i

　'名札の名前の一覧。枠にはこの順番で並ぶ
　Namae = Array("Aさん", "Bさん", "Cさん")

'　'名称から枠のオートシェイプを検索、座標を変更する。
'　varYoubi = Array("月", "火", "水", "木", "金")
'　varGyoumu = Array("業務1", "業務2", "業務3", "業務4")
'　For Each myShp In wsHyouji.Shapes
'　　For i = 1 To nYoubi
'　　　For j = 1 To nGyoumu
'　　　　If myShp.Name = varYoubi(i - 1) & "_" & varGyoumu(j - 1) Then
'　　　　　Set Waku(i, j).shp = myShp
'　　　　　myShp.Left = Waku(i, j).Left
'　　　　　myShp.Top = Waku(i, j).Top
'　　　　　myShp.Width = Waku(i, j).Width
'　　　　　myShp.Height = Waku(i, j).Height
'　　　　　GoTo ContinueWaku
'　　　　End If
'　　　Next j
'　　Next i
'ContinueWaku:
'　Next myShp
End Sub

（次に続く）

回答No.3

Mathmi

No.2です。

質問だけでは何ですので、あるオートシェイプと重なっているオートシェイプを別のオートシェイプの場所に移動するコードを組んでみました。
出勤/欠勤の取得方法とか、移動先の位置とか、テキストボックスの判別方法とか、調整する箇所は多々存在するコードです。
ある程度VBAを分かっている人向けに、自分でコードを組むときに参考となる事を目的としたものです。

Sub test()
　Dim BaseShp As Shape '移動元枠オートシェイプ
　Dim BaseRange As Range '移動元枠セル範囲
　Dim MoveShp As Shape '移動先枠オートシェイプ
　Dim MoveRange As Range '移動先枠セル範囲
　Dim myShp As Shape
　Dim myRange As Range
　Dim BaseCollection As Collection '移動元に重なっているオートシェイプ
　Dim WorkCollection As Collection '出勤/休暇の組
　Dim MoveCollection As Collection '移動先に移動するオートシェイプ
　Dim MoveCell As Range '移動先のセル

　'移動先、移動元を取得
　Set BaseShp = ActiveSheet.Shapes("Rectangle 2")
　Set BaseRange = Range(BaseShp.TopLeftCell, BaseShp.BottomRightCell)
　Set MoveShp = ActiveSheet.Shapes("Rectangle 7")
　Set MoveRange = Range(MoveShp.TopLeftCell, MoveShp.BottomRightCell)

　'移動元と重なっているオートシェイプをコレクション。
　Set BaseCollection = New Collection
　For Each myShp In ActiveSheet.Shapes
　　Set myRange = Range(myShp.TopLeftCell, myShp.BottomRightCell)
　　If Not Intersect(BaseRange, myRange) Is Nothing And Not myShp Is BaseShp Then
　　　BaseCollection.Add myShp, myShp.TextFrame.Characters.Text
　　End If
　Next myShp

　'出勤/休暇を設定
　Set WorkCollection = New Collection
　WorkCollection.Add "出勤", "Aさん"
　WorkCollection.Add "休暇", "Bさん"
　WorkCollection.Add "休暇", "Cさん"

　'休暇のオートシェイプをコレクション
　Set MoveCollection = New Collection
　For Each myShp In BaseCollection
　　If WorkCollection.Item(myShp.TextFrame.Characters.Text) = "休暇" Then
　　　MoveCollection.Add myShp
　　End If
　Next myShp

　'休暇のオートシェイプを移動
　Set MoveCell = MoveShp.TopLeftCell
　For Each myShp In MoveCollection
　　myShp.Top = MoveCell.Top
　　myShp.Left = MoveCell.Left
　　Set MoveCell = MoveCell.Offset(myShp.BottomRightCell.Row - myShp.TopLeftCell.Row + 1)
　Next myShp
End Sub

回答No.2

Mathmi

とりあえず、システムを作る側からの疑問点を何点か。

＞シート上、一定の枠内にあるテキストボックス
セルやフォームでは駄目なんでしょうか？

＞決まったボタンで別枠内に集合させる
テキストボックス等オートシェイプの操作は、関数ではなくVBAの領域です。
そのレベルの回答になってしまいますが、大丈夫ですか？
（そちらでコードを読んで改良できるレベルなのか、それとも丸コピーのコードが欲しいのか）
また、移動したテキストボックスを戻すのは、手動で行うのですか？　それとも、マクロで自動的に移動するのでしょうか？

＞テキストボックス
シート上でデータを扱う場合、基本的にセルを使います。
表示はテキストボックスで行うにしても、セルの内容を参照して行います。
もしかして、印刷用の原稿を自動で作成したい、という事なのでしょうか？

＞Ａさん、Ｂさん、Ｃさんとテキストボックスがあり
＞ＡさんＢさんが出勤でＣさんが休暇
これは、テキストボックスに表示されているのは人名のみ。
出勤/休暇のデータは別の場所に存在している、という認識でいいのでしょうか？

＞休暇枠
罫線か、図形の四角形で枠を作っているのでしょうか？
移動した後、枠のサイズは変更するのですか？　枠の大きさはどの程度で、そこに入る可能性のある人名テキストボックスはどの程度でしょうか？

総じて、どのようなデータ構造になっているのか、結果どうしたいのかが、ご質問からは分かりづらいです。
エクセル上で変更前、変更後を仮作成したものを上げて貰えれば、より分かりやすいのですが。

お礼

ご親切なご回答ありがとうございます。

補足

＞セルやフォームでは駄目なんでしょうか？
現在の稼働管理表がExcel上にあるテキストボックスに
名前が入力されているものを手動で休暇枠内から
出勤枠へドラッグ&ドロップで動かしています。
その操作先が出勤と欠勤だけでなく、
各業務項目があって専用の担当枠に入ったり休暇に移ったり
時には違った業務担当に移動したりします。
それが1週間分縦に並んでいて
一日過ぎる毎に翌週のその曜日を訂正するという
とても無駄な使い方をしているようです。

＞決まったボタンで別枠内に集合させる
勿論VBAとして質問しておりますが、私は今
VBAを得意とする方々の指導の元勉強中で
正直右も左もわかりません。ただ指導者は
別部署にしかおらず、自身が所属する部署でVBAを
仮にでもいじることができるのは私のみで
色々な無理な要求を短期間で解決するよう
依頼が上がってきます。
しかし、コードを読み解けるかと聞かれると
読み解けない、と答える方が正しいと思います。

＞テキストボックス
パソコンと繋いで電子黒板に表示するものです。

＞Aさん、Bさん、Cさんとテキストボックスがあり...
別書類の選評を見ながら、担当者が手動で移動させています。

＞休暇枠
枠のサイズは一定です。一週間一定です。
ただそれが丸一周間分縦に並んでいて
上記のように一日過ぎる度に手動で動かしています。

現在、支持のもとの突破口ですが
Sub 座標軸()
Do, Sh As Shape
For Each Sh In ActiveSheet.Shapes
MsgBox Sh.Name & ":" & (Sh.Left) & "," (Sh.Top)
Next Sh
End Sub

で各テキストボックスの座標を取得し
各テキストボックスを5日分コピーしテキストボックスに
名前を付けて、
Sub 定位置()
Dim s As Integer
Dim e As Integer

s=2
e=5

Call おーる定位置1(s,e)

End Sub

Sub おーる定位置1(s As Integer.e As Integer)
Dim i As Integer.i = 1
DIm zurashi As Integer.zurasi = 77

For i = s To e

ActiveSheet.Shapes.Range(Array("Aさん" & i().Select
Selection.ShapeRange.Left = 936
Selection.ShapeRange.Top = 26.25 + ((i - 1) * zurashi)

これで全てを5日間定位置につかせるボタンを作ったので
そこから、休暇に移したいテキストボックスを選択(アクティブな状態）にし、leftの座標だけ投入したマクロボタンを
出勤のところと休暇のところに配置し
定位置からの移動のみとする、という解決策です。

但しこれは、横並びのテキストボックスが選択された場合
全て同じ座標に重なってしまうという欠点があります。
月曜用のボタン、火曜用のボタンを
sとeに入る数値を変えることで作り分ける予定です。
タイムリミットが17日なので、
色々難点はありますが
何とか解決させようとしています。

回答No.1

imogasi

普通はＶＢＡの質問でも、すぐ回答が２－３件は出ます。しかし本件は、まだ回答が出ません。私の考えるところでは、質問の構想が、初心者にとっては（なんでもやれる熟練者ならそうい事も考えられるが）、無理があって、普通はこういう処理方式の発想はやらないからだと思います。
ーー
コントロールを、マウスで、所定の別区域に移動することで、分類や該当に役立てる発想は、小生もやりたいけれど、情報が少ない（難しい）と思う。
確かにオフィス・ソフトの中でも、ピボットテーブルだったかな、そういう仕組みは、使われている（あった）ように思う。しかしそれはマイクロソフトという超優秀な技術者だからできる仕組みではないかと思う。
　また別の広い世界では、そういう仕組みを使った、ソフトに出会ったことはあるが。ＭｏｕｓｅＭｏｖｅといった、マウスの有効利用方式とおもうが。
ー
普通はユーザーフォームに社員のテキストボックスを（多数、社員数だけ）作り、「休暇」と入れた社員は、シートなどのデータベースに一旦落として、別途そちらを読んで、休暇者分を探して、それらは所定の処理をする、といった処理構想（発想）だと思います。
　それに、同種のコントロールが１画面で多数（２－３以上か）作った（作ってある）場合、「コントロール配列」的な処理ができれば、コードがすっきりするのですが、ＶＢＡではクラスを使うとか、大変なレパートリー（学習領域）を広げる（または持っている）必要があります。
コントロール配列的とは、どういうことか、どう便利なのか、わかりますか？
初耳なら、Ｇｏｏｇｌｅで「コントロール配列とは」で照会し記事を読んでみて。
ーー
社内にでも、システムのベテランがいれば、この処理（ＧＵＩ・ユーザーインターフェイスに関する）構想を賛成するか、話し合ってみたらどうでしょう。