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也可以等待程式碼執行

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