Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8110 / 76732 ←次へ | 前へ→

【74199】Re:Listbox間のドラッグアンドドロップ
発言  kanabun  - 13/4/28(日) 8:31 -

引用なし
パスワード
   ▼亜矢 さん:

>>参考リンクだけですけど、
>>
>>mougの即効テクニックに こんなのがあります。
>>■ドラッグ&ドロップ−ListBox⇒ListBox
>>ht tp://www.moug.net/tech/exvba/0150045.html

> 上記の2点はすでにチェック済みでした。

> 結局Listboxが1列だけが取得されています。
> 今考えているのは10列のリストボックスでリストボックスで行を選択したときに
> その10列そのものが移動してほしいことなのです。

そういうことでしたか、それは失礼しました。
いま問題になっていることは主として2つの点だと思います。

1. 1列目だけでなく、10列一括して移動したい。
2. ドロップした位置に挿入したい

そこで、(きょうはちょっと時間がないので)
1.のほうだけ
mougの参考ページをアレンジしながら、
ListBox1から 任意のアイテムを ListBox2 の先頭アイテムに
追加する 処理だけ、編集してみます。

修正内容は
DataObjectにクリップするとき、列データをTABコードを
区切り記号として連結した文字列を送り、
ListBox2でドロップするとき、 DataObjectの文字列を
TABで列に分解して 0番アイテムに挿入する。
ということです。

Private Sub UserForm_Initialize()
  With ListBox1
    .List = Range("A1:D10").Value
    .ColumnCount = 4
    .ColumnWidths = "20;20;20;20"
  End With
  With ListBox2
    .List = Range("A11:D26").Value
    .ColumnCount = 4
    .ColumnWidths = "20;20;20;20"
  End With
  
End Sub


'○リストボックス1のマウス移動時イベント(ドラッグ開始)
Private Sub ListBox1_MouseMove _
  (ByVal Button As Integer, ByVal Shift As Integer, _
  ByVal X As Single, ByVal Y As Single)
  'マウス左ボタンのドラッグ時に対応
  If Button <> 1 Then Exit Sub
  'データオブジェクトに現在の選択地を格納
  Dim i As Long
  With ListBox1
    ReDim ss(.ColumnCount - 1)
    For i = 0 To .ColumnCount - 1
      ss(i) = .List(.ListIndex, i)
    Next
  End With
  With New DataObject
    .SetText Join(ss, vbTab)
    .StartDrag 'ドラッグ開始
  End With
End Sub


'○リストボックス2へのドラッグ(In) ----- 無修正
Private Sub ListBox2_BeforeDragOver _
  (ByVal Cancel As MSForms.ReturnBoolean, _
  ByVal Data As MSForms.DataObject, _
  ByVal X As Single, ByVal Y As Single, _
  ByVal DragState As MSForms.fmDragState, _
  ByVal Effect As MSForms.ReturnEffect, _
  ByVal Shift As Integer)
'二番目のリストボックスにマウスが入った時のイベント
'Cancel=TrueでDrag&Drop継続
Cancel = True

End Sub


'○リストボックス2へのドロップ
Private Sub ListBox2_BeforeDropOrPaste _
    (ByVal Cancel As MSForms.ReturnBoolean, _
    ByVal Action As MSForms.fmAction, _
    ByVal Data As MSForms.DataObject, ByVal X As Single, _
    ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, _
    ByVal Shift As Integer)
 Dim ss
 Dim i As Long
 Dim NewIndex As Long
  'ドラッグ時のみドラッグされたデータをリスト項目に追加
  If Action = fmActionDragDrop Then
    ss = Split(Data.GetText(), vbTab)
    
    With ListBox2
      .AddItem ss(0), NewIndex
      For i = 1 To UBound(ss)
        .List(NewIndex, i) = ss(i)
      Next
      .TopIndex = 0
    End With
  End If
  Data.Clear 'DataObjectのデータクリア

End Sub

ListBox2でマウスをドロップした位置へ AddItem する方法は
ListBox2のうえを MouseMove するとき X,Y座標が得られますので、
それを「一行の行間を含む高さ」で除してやれば .ListIndex が
得られるので、これを使います。

0 hits

【74193】Listbox間のドラッグアンドドロップ 亜矢 13/4/27(土) 20:52 質問
【74195】Re:Listbox間のドラッグアンドドロップ kanabun 13/4/27(土) 21:29 発言
【74197】Re:Listbox間のドラッグアンドドロップ 亜矢 13/4/28(日) 4:30 質問
【74198】Re:Listbox間のドラッグアンドドロップ UO3 13/4/28(日) 8:25 発言
【74199】Re:Listbox間のドラッグアンドドロップ kanabun 13/4/28(日) 8:31 発言
【74202】Re:Listbox間のドラッグアンドドロップ 亜矢 13/4/28(日) 12:25 発言
【74203】Re:Listbox間のドラッグアンドドロップ kanabun 13/4/28(日) 12:26 発言
【74204】Re:Listbox間のドラッグアンドドロップ kanabun 13/4/28(日) 14:40 発言
【74205】Re:Listbox間のドラッグアンドドロップ 亜矢 13/4/28(日) 15:47 質問
【74206】Re:Listbox間のドラッグアンドドロップ kanabun 13/4/28(日) 17:02 発言
【74212】エウレカ! 13/4/29(月) 7:18 発言
【74209】Re:Listbox間のドラッグアンドドロップ UO3 13/4/28(日) 21:54 発言
【74210】Re:Listbox間のドラッグアンドドロップ UO3 13/4/28(日) 21:58 発言
【74217】Re:Listbox間のドラッグアンドドロップ Abyss 13/4/29(月) 23:17 発言
【74219】Re:Listbox間のドラッグアンドドロップ kanabun 13/4/30(火) 9:26 発言
【74224】Re:Listbox間のドラッグアンドドロップ UO3 13/4/30(火) 14:33 発言
【74221】Re:Listbox間のドラッグアンドドロップ kanabun 13/4/30(火) 13:03 発言
【74222】Re:Listbox間のドラッグアンドドロップ kanabun 13/4/30(火) 13:17 発言
【74223】Re:Listbox間のドラッグアンドドロップ 亜矢 13/4/30(火) 14:24 質問
【74225】Re:Listbox間のドラッグアンドドロップ UO3 13/4/30(火) 15:23 発言
【74226】Re:Listbox間のドラッグアンドドロップ Abyss 13/4/30(火) 18:23 発言
【74227】Re:Listbox間のドラッグアンドドロップ Abyss 13/4/30(火) 19:32 発言
【74232】Re:Listbox間のドラッグアンドドロップ 亜矢 13/5/1(水) 3:23 質問
【74233】Re:Listbox間のドラッグアンドドロップ kanabun 13/5/1(水) 9:01 発言
【74234】Re:Listbox間のドラッグアンドドロップ 亜矢 13/5/1(水) 9:09 発言
【74237】Re:Listbox間のドラッグアンドドロップ kanabun 13/5/1(水) 10:32 発言
【74236】Re:Listbox間のドラッグアンドドロップ UO3 13/5/1(水) 9:37 発言
【74238】Re:Listbox間のドラッグアンドドロップ Abyss 13/5/1(水) 12:11 発言
【74258】Re:Listbox間のドラッグアンドドロップ 亜矢 13/5/8(水) 19:56 お礼

8110 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free