| |
あさにレスした
> 1. 1列目だけでなく、10列一括して移動したい。
のコードに、さらに
>2. ドロップした位置に挿入したい 1. コードに
を加えてみました。
ただし、いろいろ簡略化のために決め打ちしているところが
ありますので、適宜そちらの環境に修正してください。
a) ListBoxは ListBox1とListBox2 だけを使い、
方向は ListBox1 でDrag開始して、 ListBox2 へのＤｒｏｐだけ
に限定している。
b) ListBoxへのListのセットはシートのA〜Dの4列をセットしている
c) 一行の高さを変数TextHiに求めているが
> TextHi = lngHeight * 72 / 96 'DPI 決め打ち
コメントにあるように、DPI を 96 に決め打ちしている。
ここは APIを使って 96 を求めたほうがよい。
また、ListBox1 と ListBox2 で使用しているFont は 同じと仮定。
'-----------------------------------
Option Explicit
Private TextHi As Long 'ListBox リストの一行の高さ（全ListBox共通）
'//ユーザフォーム初期化
Private Sub UserForm_Initialize()
Dim acc As IAccessible
Dim lngHeight As Long
'ListBoxに初期リストのセット
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
'一行の高さをListBox1から得る
Set acc = ListBox1
acc.accLocation 0&, 0&, 0&, lngHeight, 1&
TextHi = lngHeight * 72 / 96 'DPI 決め打ち
End Sub
'//ListBox1 ドラッグ開始
'// マウス左ボタンのドラッグ時に対応
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
'DataObjectに現在の選択アイテム値（複数列）格納
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
'//ListBox2にマウスが入った時のイベント
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
'// ListBox2へのドロップ
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
NewIndex = .TopIndex + Y \ TextHi
.AddItem ss(0), NewIndex
For i = 1 To UBound(ss)
.List(NewIndex, i) = ss(i)
Next
.TopIndex = NewIndex
End With
End If
Data.Clear 'DataObjectのデータクリア
End Sub
|
|
kanabun
- 13/4/28(日) 12:26 -
