2025/06/16

Excel / 使用VBA執行ffmpeg合併圖檔與音檔成為影音檔 2

接續上一篇「Excel / 使用VBA執行ffmpeg合併圖檔與音檔成為影音檔

現在將程式碼改寫為以工作表為資料庫,記錄每筆影音檔的圖檔來源、音檔來源與輸出檔案的路徑

程式碼流程可以分為2個部分

1.選取檔案

2.將檔案路徑寫入工作表,合併檔案


工作表的架構如下

 

再來是程式碼的設計

1.選取檔案

利用FileDialog(msoFileDialogFilePicker)物件來取得檔案路徑

可以設定2個按鈕來分別選取圖檔跟音檔

也可以設定1個按鈕來執行選取圖檔跟音檔

1-1 設定2個按鈕

選取圖檔

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30


Sub seleImg()
r = Sheets(1).Range("B1").End(xlDown).Row
If r = 1048576 Then
r = 2
Else
r = r + 1
End If

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)

Dim filePath As Variant

With fd
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Images", "*.jpg; *.jpeg"
.Title = "選取圖檔"
End With

If fd.Show = -1 Then

filePath = fd.SelectedItems(1)
Debug.Print filePath
Sheets(1).Range("B" & r).Value = filePath

End If

Set fd = Nothing
End Sub





 

選取音檔

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30


Private Sub seleWav()
r = Sheets(1).Range("C1").End(xlDown).Row
If r = 1048576 Then
r = 2
Else
r = r + 1
End If

Dim fd2 As FileDialog
Set fd2 = Application.FileDialog(msoFileDialogFilePicker)

Dim filePath As Variant

With fd2
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Wav", "*.wav"
.Title = "選取音檔"
End With

If fd2.Show = -1 Then

filePath = fd2.SelectedItems(1)
Debug.Print filePath
Sheets(1).Range("C" & r).Value = filePath

End If

Set fd2 = Nothing
End Sub





 

#2-7

因為取得工作表目前列數方法的關係,如果只有欄位名稱有資料(也就是第2列沒資料)

會取得工作表的最後一列-1048576

所以用判斷式來處理,如果取得的列數是1048576,就表示第2列沒資料

要寫入的列數位置直接設定為2

如果不是,要寫入的列數位置就是設定為取得的列數+1

#14-19

設定FileDialog(msoFileDialogFilePicker)參數,原本是沒有設定參數

因為後來再設定合併成1個按鈕的程式,執行之後發現FileDialog都會留著上一次執行的設定

即使已經用Nothing釋放物件,仍然一樣

所以只好增加參數來覆寫之前執行留下的舊設定

1-2 合併為1個按鈕

把2個按鈕執行的程式合併在1個按鈕中執行

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50


Public Sub inputImg_Wav()
r = Sheets(1).Range("B1").End(xlDown).Row
If r = 1048576 Then
r = 2
Else
r = r + 1
End If

Dim fd3 As FileDialog
Set fd3 = Application.FileDialog(msoFileDialogFilePicker)

With fd3
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Images", "*.jpg; *.jpeg"
.Title = "選取圖檔"
End With

Dim filePath3 As Variant

If fd3.Show = -1 Then
filePath3 = fd3.SelectedItems(1)
Debug.Print filePath3
Sheets(1).Range("B" & r).Value = filePath3

End If

Set fd3 = Nothing

Dim fd4 As FileDialog
Set fd4 = Application.FileDialog(msoFileDialogFilePicker)

With fd4
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Wav", "*.wav"
.Title = "選取音檔"
End With

Dim filePath4 As Variant

If fd4.Show = -1 Then
filePath4 = fd4.SelectedItems(1)
Debug.Print filePath4
Sheets(1).Range("C" & r).Value = filePath4

End If

Set fd4 = Nothing
End Sub





 

備註

執行之後,再執行上面的選取圖檔或音檔的程式,FileDialog都會寫入舊設定

所以才在選取圖檔跟選取音檔的程式中增加設定參數來覆寫舊設定

2.合併檔案,將檔案路徑寫入工作表

這其實包含2個流程,合併檔案跟將資料寫入工作表

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49


Sub creatVideo()
r = Sheets(1).Range("B1").End(xlDown).Row
If r = 1048576 Then
Exit Sub
End If

For i = 2 To r

If Sheets(1).Range("A" & i).Value <> "◎" Then

If Sheets(1).Range("B" & i).Value <> "" And Sheets(1).Range("C" & i).Value <> "" Then
imgPath = Sheets(1).Range("B" & i).Value
wavPath = Sheets(1).Range("C" & i).Value

n = InStr(1, wavPath, ".", vbTextCompare)
mp4Name = Mid(wavPath, 1, n - 1) & ".mp4"

Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 3
Dim errorCode As Long

' 如果用環境參數在WScript.Shell會無法執行
' ffmpegFile = "C:\Users\trico\Desktop\ffmpeg\bin\ffmpeg.exe"
ffmpegFile = "C:\Users\edu\Desktop\yt-dlp\ffmpeg\bin\ffmpeg.exe"

s = ffmpegFile & " -framerate 1 -i " & imgPath & " -i " & Chr(34) & wavPath & Chr(34) & " -f mp4 -c:v libx264 -pix_fmt yuv420p " & Chr(34) & mp4Name & Chr(34)
Debug.Print s

' Shell
' Shell s, windowStyle

' WScript.Shell
errorCode = wsh.Run(s, windowStyle, waitOnReturn)

If errorCode = 0 Then
' MsgBox "Done! No error to report."
Debug.Print "輸出:" & mp4Name
Sheets(1).Range("A" & i).Value = "◎"
Sheets(1).Range("D" & i).Value = mp4Name
Else
MsgBox "Program exited with error code " & errorCode
End If
End If
End If
Next

End Sub





 

整體而言是利用迴圈分別讀取工作表上的檔案路徑

再合併成命令

不過VBA內建的shell無法等待外部程式執行完畢,這樣程式會出錯

而WScript.Shell可以在第3個參數,設定是否等待程式執行完畢再往後執行

所以這裡的程式是使用WScript.Shell來執行命令串

此外,不知道為什麼環境參數會出錯,會找不到ffmpeg.exe,所以改用絕對路徑

#2-5

如果第2列沒資料就終止程式

如果有資料,r就是目前有資料的列數

#7-47

利用迴圈從第2列開始讀取工作表到有資料的列數範圍,依次執行合併程式

#9-46

用來判斷A欄是否已經寫入"◎",這是配合#40的程式碼流程─合併成功,在A欄寫入"◎"

#11-45

判斷目前列數的B、C欄是否都有資料

#37-44

判斷WScript.Shell執行狀態

如果沒有錯誤,也就是回傳值=0,在A欄寫入"◎"、D欄寫入輸出檔案路徑

如果回傳值>0,則寫出錯誤代碼

之後再來補充利用調用API,讓VBA內建的shell也可以等待程式碼執行

以及利用表單的方式來執行這些流程

0 comments:

張貼留言