みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

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

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

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

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

投稿日時 - 2019-07-11 18:58:38

QNo.9634310

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.5

(前の回答より)



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
******************************



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

投稿日時 - 2019-07-13 18:40:08

ANo.4

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

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



適宜変更して貰う点としましては
・表示するシート:[設定]プロシージャの[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



(次に続く)

投稿日時 - 2019-07-13 18:36:53

ANo.3

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

投稿日時 - 2019-07-12 15:34:19

ANo.2

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

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

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

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

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

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


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

投稿日時 - 2019-07-12 14:01:35

補足

>セルやフォームでは駄目なんでしょうか?
現在の稼働管理表が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日なので、
色々難点はありますが
何とか解決させようとしています。

投稿日時 - 2019-07-13 06:57:16

お礼

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

投稿日時 - 2019-07-13 06:57:45

ANo.1

普通はVBAの質問でも、すぐ回答が2-3件は出ます。しかし本件は、まだ回答が出ません。私の考えるところでは、質問の構想が、初心者にとっては(なんでもやれる熟練者ならそうい事も考えられるが)、無理があって、普通はこういう処理方式の発想はやらないからだと思います。
ーー
コントロールを、マウスで、所定の別区域に移動することで、分類や該当に役立てる発想は、小生もやりたいけれど、情報が少ない(難しい)と思う。
確かにオフィス・ソフトの中でも、ピボットテーブルだったかな、そういう仕組みは、使われている(あった)ように思う。しかしそれはマイクロソフトという超優秀な技術者だからできる仕組みではないかと思う。
 また別の広い世界では、そういう仕組みを使った、ソフトに出会ったことはあるが。MouseMoveといった、マウスの有効利用方式とおもうが。

普通はユーザーフォームに社員のテキストボックスを(多数、社員数だけ)作り、「休暇」と入れた社員は、シートなどのデータベースに一旦落として、別途そちらを読んで、休暇者分を探して、それらは所定の処理をする、といった処理構想(発想)だと思います。
 それに、同種のコントロールが1画面で多数(2-3以上か)作った(作ってある)場合、「コントロール配列」的な処理ができれば、コードがすっきりするのですが、VBAではクラスを使うとか、大変なレパートリー(学習領域)を広げる(または持っている)必要があります。
コントロール配列的とは、どういうことか、どう便利なのか、わかりますか?
初耳なら、Googleで「コントロール配列とは」で照会し記事を読んでみて。
ーー
社内にでも、システムのベテランがいれば、この処理(GUI・ユーザーインターフェイスに関する)構想を賛成するか、話し合ってみたらどうでしょう。

投稿日時 - 2019-07-12 11:15:52

あなたにオススメの質問