[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイルをドラッグ＆ドロップして 一括処理』（豊島）
現在、以下のマクロでターゲットフォルダーを選択して
フォルダ内のファイル名等を取得しています。
|[A] |[B] |[C] |[D] |[E]
[1] |[No.]|[ファイル名] |[サイズ]|[長さ] |
[2] | 1|S02E01.Spoils.of.War.mkv |484 MB |0:21:54 |
[3] | 2|S02E02.Ruins.of.War.mkv |558 MB |0:25:28 |
[4] | 3|S02E03.The Solitary Clone.mkv |609 MB |0:27:46 |
[5] | 4|S02E04.Faster.mkv |512 MB |0:23:10 |
[6] | 5|S02E05.Entombed.mkv |595 MB |0:27:06 |
[7] | 6|S02E06.Tribe.mkv |572 MB |0:25:58 |
[8] | 7|S02E07.The.Clone.Conspiracy.mkv |578 MB |0:26:25 |
[9] | 8|S02E08.Truth.and.Consequences.mkv|622 MB |0:28:18 |
[10]| 9|S02E09.The.Crossing.mkv |601 MB |0:27:40 |
[11]| 10|S02E10.Retrieval.mkv |596 MB |0:27:07 |
[12]| 11|S02E11.Metamorphosis.mkv |601 MB |0:27:26 |
[13]| 12|S02E12.The Outpost.mkv |630 MB |0:28:56 |
[14]| 13|S02E13.Pabu.mkv |565 MB |0:25:32 |
[15]| 14|S02E14.Tipping Point.mkv |575 MB |0:26:25 |
[16]| 15|S02E15.The Summit.mkv |536 MB |0:24:32 |
[17]| 16|S02E16.Plan.99.mkv |554 MB |0:25:27 |
[18]| | ------- 総計 ------- |8.98 GB |06: 59: 10|[hh:mm:ss]
[19]| | | |419: 10 |[mm:ss]
これをセルにエクスプローラからファイル（又はフォルダー）をドラッグ＆ドロップして
一括で処理出来ればと思っています。
参考になりそうな参考記事を見つけましたが
https://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_100_130.html
記事は、ユーザーフォーム利用していますが出来れば使用しないで処理したいです。
Option Explicit
Sub 動画時間取得()
Dim Shell, Folder
Dim fil
Dim cnt As Long
Dim i As Long
Dim el As Long
Set Shell = CreateObject("Shell.Application")
Dim folderPath As Variant
'ターゲットフォルダー選択
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
folderPath = .SelectedItems(1)
End With
Set Folder = Shell.Namespace(folderPath)
fil = Dir(folderPath & "\*.*")
Worksheets("動画名").Columns("A:E").Clear
Cells(1, 1) = "[No.]"
Cells(1, 2) = "[ファイル名]"
Cells(1, 3) = "[サイズ]"
Cells(1, 4) = "[長さ]"
cnt = 1
Do While fil <> ""
cnt = cnt + 1
Cells(cnt, 1) = cnt - 1
Cells(cnt, 2) = Folder.GetDetailsOf(Folder.ParseName(fil), 0) ' ファイル名
Cells(cnt, 3) = Folder.GetDetailsOf(Folder.ParseName(fil), 1) ' サイズ
Cells(cnt, 5) = Left(Cells(cnt, 3), InStr(Cells(cnt, 3), " ") - 1)
Cells(cnt, 4) = Folder.GetDetailsOf(Folder.ParseName(fil), 27) ' 再生時間
fil = Dir()
Loop
Dim rng1 As Range, rng2 As Range
Dim tmb As Long
el = Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = Range("E2:E" & el)
Set rng2 = Range("D2:D" & el)
Cells(el + 1, "D") = Application.WorksheetFunction.Sum(rng2)
tmb = Application.WorksheetFunction.Sum(rng1)
If tmb > 1024 Then
Cells(el + 1, "C") = WorksheetFunction.RoundUp((tmb / 1024), 2) & " GB"
Else
Cells(el + 1, "C") = tmb & " MB"
End If
Cells(el + 1, "C").NumberFormatLocal = "###,###,###"
Cells(el + 1, "D").NumberFormatLocal = "hh: mm: ss"
Cells(el + 2, "D").Value = Cells(el + 1, "D").Value
Cells(el + 2, "D").NumberFormatLocal = "[mm]: ss"
'仮計算用のE列をクリアー
Worksheets("動画名").Columns("E:E").Clear
Cells(el + 1, 2) = " ------- 総計 ------- "
Cells(el + 1, 5) = "[hh:mm:ss]"
Cells(el + 2, 5) = "[mm:ss]"
Set Folder = Nothing
Set Shell = Nothing
ActiveSheet.Cells.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
＜ 使用 Excel：Excel2021、使用 OS：Windows11 ＞
ドロップ＆ドラッグで添付ファイルを選択させる方法
投稿日時: 23/04/26 16:37:35
投稿者: HT
https://www.moug.net/faq/viewtopic.php?t=82207&sid=faa984b4951dc01640e42613d5b31b19
（嘘つきばっか） 2023/05/01(月) 13:07:30
エクセルﾌﾞｯｸやﾃｷｽﾄﾌｧｲﾙはシート上にドラッグ＆ドロップ したらエクセル上でイベントが発生しますが、エクセル以外の ファイルやフォルダはエクセルは関知しない(感知もびない)ので ユーザーフォームを使わない限り無理だと思います。
WindowsAPIを駆使したら出来ないこともないとは思いますが、 私はそこまでのスキルがないので開設はできません。 （MK） 2023/05/01(月) 13:44:06
ユーザーフォームを使わない限り無理な相談ならば諦めます。
（豊島） 2023/05/01(月) 14:05:03
ワークシート上にActiveXコントロールとして ListViewコントロールを配置したらユーザーフォーム を使わなくて済みます。 お望みの形かどうかはわかりませんが。 （MK） 2023/05/01(月) 14:26:50
これも過去の遺物化しつつありますが、 ListView以外にWebBrowserコントロール もドラッグ＆ドロップを受け付けます。 （MK） 2023/05/01(月) 14:30:57
賢明な判断だと思います。 WinAPIを使えばできるのかもしれませんが、難易度は相当高いものと推測します。 正直申し上げて、文字フォントを太字にするといった質問をされるような方（[[20230430163044]])が 取り組む課題ではないように思います。 それに、フォルダ配下の全ファイルだから、D&Dにこだわる必要も更々なく、今のままで機能的に十分でしょう。
（xyz） 2023/05/01(月) 15:18:38
興味があるので少し調べ始めました。
ワークシートにActiveこんとロールを挿入しようとしましたが
ActiveXコントロールの一覧中にListViewが無いので
コントロールの選択にある
「Microsoft ListView Control,version 6.0」を選択してOKをクリックしても
同ListViewコントロールが一覧表中に表示されません。
何か手順が間違っているようです。
（豊島） 2023/05/01(月) 15:44:44
一覧には表示されません。
が、シートに配置できる状態になっています。 配置したい箇所をドラッグしたらドラッグ した範囲にListViewができるはずです。 （MK） 2023/05/01(月) 15:50:32
教えてもらった手順でListViewが配置されました。
あれこれ試していますが、xyzの書き込みにもありますが
参考になりそうなネット情報も検索してみましたが
事例も殆どなく
素人の付け焼き刃で何とかなるレベルではなさそうなので諦めました。
現状のマクロままで対処する事にしました。
（豊島） 2023/05/01(月) 17:12:49
LisyViewをユーザーフォームに配置して以下のコードでDrag&Dropできるようになりましたが
ユーザーフォームを呼び出した所でワークシート画面が消えてしまい
Drag&Dropでファイル名等が表示されてユーザーフォームを閉じるの右上の「X」を押しても
ワークシート画面は消えたままです。
ユーザーフォームを呼び出しても
最初のワークシート画面を表示したままにする方法を教えてください。
以下現在のコードです。
Public Sub Main_Form_Show()
Excel.Application.Visible = False
UserForm1.Show vbModeless
End Sub
'-----------------------------------------------------------------------------
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
With ListView1
If .ListItems.Count < 1 Then Exit Sub
ActiveCell = .SelectedItem.SubItems(1)
End With
End Sub
Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
'【変数】
Dim i As Long 'カウンター
Dim fileCount As Long 'ファイル数
With ListView1
'■既存ファイル名のクリア
.ListItems.Clear
'■ファイル数の取得
fileCount = Data.Files.Count
'■ドラッグ＆ドロップしたファイル名・ファイルパスを順にリスト化
For i = 1 To fileCount
With .ListItems.Add
.Text = Dir(Data.Files(i)) 'ファイル名
.SubItems(1) = Data.Files(i) 'ファイルパス
End With
Next i
End With
End Sub
Private Sub UserForm_Initialize()
With ListView1
'■プロパティ設定
.FullRowSelect = True '行全体の選択
.Gridlines = True '行列グリッド線の表示
.LabelEdit = lvwManual 'ラベル編集不可
.OLEDropMode = ccOLEDropManual 'ファイルドロップ処理
.View = lvwReport '表示形式
'■列見出しの名前・列幅の設定
.ColumnHeaders.Add , "key1", "ファイル名", 300, lvwColumnLeft
.ColumnHeaders.Add , "key2", "ファイルパス", 550, lvwColumnLeft
End With
End Sub
（豊島） 2023/05/02(火) 11:47:11
以下で消してしまっていました。
Excel.Application.Visible = False
（豊島） 2023/05/02(火) 11:59:25
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.