プロが教えるわが家の防犯対策術!

(A)
ExcelのVBAのListBox(か、類似のVBA機能)を使用してファイル(.csvファイルのデータ)の一覧を作成し、ドラッグアンドドロップ/D&Dで元エクセルシートに落としたセルを起点とし、選択したファイル内のデータを展開するデータを作ろうとしています。その際に分からないことが2点あります。

(A1)
他のワードファイルにはドドロップが有効なのですが、元エクセルファイルにはなぜかカーソルが例の進入禁止マーク(?)化してドロップできません。どうすれば元エクセルファイルにデータをドロップ出来るようになるのでしょうか?

(A2)
さらに、ドロップした後のセル("A3"や"B6"とか)の求め方が分かりません。
Private Sub ListBox1_MouseMove(ByVal Button As Integer, _
 ByVal Shift As Integer, _
 ByVal x As Single, _
 ByVal y As Single)
でx,yが座標を示すことは分かるのですが、ここからセルに変換するすべはあるのでしょうか?


(B)
また、Aで詰まったときに考えたのですが、ListBoxを表示させる代わり、に別シートに件のファイル一覧を展開して元シートと別シートを並べて表示させ(Windows.Arrange xlArrangeStyleVerticalを使用)、別シートから元シートにファイル名をドラッグアンドドロップしたときに同じ処理をするのもありかな、と思いついたのですが…

(B1)
Workbookの中の"SheetBeforeDoubleClick"や"Workbook_BeforeSave"が出ているリストの中にドラッグアンドドロップを示すようなものがないのですが、当該の処理は出来ないのでしょうか?

--------------------
当方、Excel2007のVBAを使用しています。

長文になりましたが、AまたはBのどちらかが解決する必要があります。断片的な答えでも大歓迎です。お願いします!

A 回答 (3件)

エクスプローラーやVixから、画像をワークシートにドラッグ&ドロップ


するものを作成した事があります。
サブクラス化という手法を用いて、Windowsのメッセージを横取りして、
それに対する処理を自分で定義してやります。
VBAでサブクラス化する方法は、下記リンクをご参照下さい。
http://www11.plala.or.jp/micras/software/whywhat …
WM_DROPFILESというメッセージに対して、
DragQueryFileというAPIを用いて、ドロップされたファイルのリストを
取得します。
標準の状態では、エクセルのワークシートはドラッグアンドドロップを
受け付けない仕様なのでしょう。
ただ、ワークシートに対するサブクラス化は不安定とされていますので、
お勧めしません。また、Web上の参考コードを切り貼りするにも(自分の事です)
Win32プログラミングのさわりは理解しておく必要があります。
http://homepage2.nifty.com/c_lang/index_sdk.html
なお、当方xl2000なので、2007にも通用するかどうかはわかりかねます
    • good
    • 0

>x,yが座標を示すことは分かるのですが、ここからセルに変換するすべはあるのでしょうか?


x,y からは、変換は事実上できません。

ワークシートには、画像はD&Dは可能ですが、一般のファイルをD&Dは出来ません。サブクラス化する場合は、対象物が、Application 直接(フレームの部分)なら可能ですが、シートオブジェクトは、出来なかったはずです。

(これらは、私の知っている範囲内だけですが)

>Private Sub ListBox1_MouseMove(ByVal Button As Integer, _
画像は、ある程度の範囲があるものですから良いのですが、ListBox1 内で、マウスカーソルが固定しないので、リストを外すことがあるようです。D&Dでは上手くないと思います。UserForm だけなら可能ですが、ワークシート側で、サブクラス化してできたという話しは聞いたことがありません。多くの人たちが挑戦はしているだろうとは思います。

リストとセルを、[クリック] to [クリック]で作ってみました。

気にいらないかもしれませんが、こんな風にしか考えつきませんね。
どのブックのシートでも、クリックしてダウンロードが可能です。

Test_Click()を、コマンドボタンに取り付けてください。
'-------------------------------------------
'ユーザーフォームの [ShowModal -- False] にするか、* UserForm1.Show False で起動
'ユーザーフォーム・モジュール
Private Sub UserForm_Terminate()
 flg = False
 fileName = ""
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 fileName = ""
 fileName = ListBox1.Value
End Sub

Private Sub Userform_Initialize()
 flg = True

 'リストボックスに入れる(ファイル名)
 Ar = Array( _
"C:\test1Fold\005.csv", _
"C:\test1Fold\004.csv", _
"C:\test1Fold\003.csv", _
"C:\test1Fold\002.csv", _
"C:\test1Fold\001.csv")
 ListBox1.List = Ar

End Sub

'-------------------------------------------
'標準モジュール
Public flg As Boolean
Public fileName As String
Public myClass As Class1

Sub Test_Click()
'*起動用
 Set myClass = New Class1
 Set myClass.xlApp = Application
 UserForm1.Show False 'モーダルモード False
End Su

'-------------------------------------------
''Class モジュール(デフォルト名は、Class1)
Public WithEvents xlApp As Application
Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If flg Then
 ImportedCSV Target, fileName
End If
End Sub

Private Sub ImportedCSV(rng As Range, fileName As String)
Dim i As Long, j As Long, k As Long
Dim Fnum As Integer
Dim myArray As Variant
Dim textLine As String
  If fileName = "" Then Exit Sub
  If Dir(fileName) <> "" Then
  If Not fileName Like "*.csv" Then Exit Sub 'CSVでなければ、離脱
  j = rng.Row
  Application.ScreenUpdating = False
    Fnum = FreeFile()
    Open fileName For Input As #Fnum
    Do While Not EOF(Fnum)
      Line Input #Fnum, textLine
      '行を範囲内に収める
      If j + i > Rows.Count Then Exit Sub
      i = i + 1
      If textLine <> "" Then
       myArray = Split(textLine, ",")
       '列を範囲内に収める
       If UBound(myArray) + 1 > Columns.Count Then
         k = Columns.Count
       Else
         k = UBound(myArray) + 1
       End If
       rng.Cells(i).Resize(, k).Value = myArray
      End If
    Loop
    Close #Fnum
  End If
  fileName = "" '一回のクリックで、二回目は使えない
End Sub
'=========================================
    • good
    • 0
この回答へのお礼

いつもご回答いただき、どうもありがとうございます。

私が言うようなD&Dは出来ないとWendy02さんがおっしゃるのであれば、なんだかあきらめもつく感じです。はい、現在私のシステムはクリックからクリックなので、私もWendy02さんと同じ結論を出していた
ということで、とても誇らしいです(笑)

ご返答、ありがとうございました

お礼日時:2010/04/23 02:40

#1です。


表現が悪かったですが、シートオブジェクトをサブクラス化している訳ではありません。
FindWindow("XLMAIN", vbNullString)
に対してサブクラス化しています。
ただ、枠だけではなくて、エクセルのウィンドウ全体にたいして、動作します。

マウスクリックした座標から、セル座標を求めるのは、苦肉の策ですが、
DragQueryPointで得られるクライアント座標→スクリーン座標→ポイント値に変換し、
http://home.att.ne.jp/zeta/gen/excel/c04p06.htm
あたりを参考に、ワークシートの列方向、行方向に対して、1から最後までセルのサイズ
(ポイント)の累積値を計算して、マウス座標を変換した値と比較するループを回して、
セル幅の範囲内に含む行、列を求めています。ワークシートの左上隅付近で仕事している分には
レスポンスは気になりません。(それ以前に、しっかりスクロールしても、誤差無くセル位置を
捉まえられるかどうかの検証も不十分ですが)

モジュールを分けただけで容易に暴走してしまう等不安定で、自信を持ってお勧めできる
ものではありません。
    • good
    • 0
この回答へのお礼

むむむ、やはりこの手の変換からセルの累積値を求めるしか方法はありませんか。はい、mitarashiさんがおっしゃる通り、問題がたくさん出ました。。しかし、やり方が他に考えられないことが大変参考になりました。ありがとうございました。

お礼日時:2010/04/23 02:35

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!