2024年1月10日 星期三

VBA / Excel VBA 播放音檔

這個是臉書社群的問題
   
 研究了一下 我一開始的構想是用 cmd 執行播放程式，例如：windows media player 後來爬文知道 cmd 就是預設用 windows media player 來開啟音檔 而在VBA 可以用 Shell函數 或者引用  WScript.Shell物件來執行cmd 但是其實也可以直接用 Shell函數 或者 WScript.Shell物件執行 windows media player 不需要再調用 cmd來執行 windows media player 後來爬文發現另一個方式是調用winmm.dll 的sndPlaySoundA 或 PlaySoundA 以下分別說明這幾種方式的應用

Shell函數

{{CODE-4616}}
Windowstyle 常數 值 描述
vbHide 0 隱藏視窗，且將焦點傳遞給隱藏視窗。 VbHide 常數不適用於 Macintosh 平台。
vbNormalFocus 1 視窗有焦點並還原成原始的大小和位置。
vbMinimizedFocus 2 視窗顯示為具有焦點的圖示。
vbMaximizedFocus 3 視窗最大化且具有焦點。
vbNormalNoFocus 4 視窗還原為最近的大小和位置。 目前的作用中視窗仍維持作用中。
vbMinimizedNoFocus 6 視窗顯示為圖示。 目前的作用中視窗仍維持作用中。 
 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
 
Public Sub Shell_1()

    Dim RetVal '接收回傳執行情況
    
    RetVal = Shell("C:\Program Files (x86)\Windows Media Player\wmplayer.exe C:\windows\media\chord.wav", 0)
    
    If RetVal = 0 Then
        MsgBox "執行失敗"
    End If
    
End Sub
'
'
Public Sub Shell_2()

    Dim RetVal '接收回傳執行情況
    
    'cmd 語法
    'https://learn.microsoft.com/zh-tw/windows-server/administration/windows-commands/cmd
    RetVal = Shell("cmd.exe /S /C" & "C:\windows\media\chord.wav", 0)
  
    If RetVal = 0 Then
        MsgBox "執行失敗"
    End If
    
End Sub
 

WScript.Shell

語法 .Run(ByVal Command As String, [ByVal WindowStyle], [ByVal WaitOnReturn]) As Integer WindowStyle:跟Shell函數一樣 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
 
Public Sub ws1()

    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    
    'cmd 語法
    'https://learn.microsoft.com/zh-tw/windows-server/administration/windows-commands/cmd
    wsh.Run "cmd.exe /S /C" & "C:\windows\media\chord.wav", 0, 0

End Sub
'
'
Public Sub ws2()
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")

    wsh.Run "wmplayer.exe C:\windows\media\chord.wav", 0, 0
End Sub
  無論是Shell函數 還是 WScript.Shell 只要是透過執行cmd來啟動 wmplayer.exe windows media player都會顯示視窗，無法隱藏，原因在於wmplayer.exe是被cmd啟動的

sndPlaySoundA

引用 winmm.dll 的sndPlaySoundA

參數1 pszSoundName

檔案路徑

參數2 uFlags

SND_ASYNC 異步/非同步 ，也可以用1，播放開始後即往下執行 SND_SYNC 同步，也可以用0，播放完了才往下執行 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
 
#If VBA7 Then
'Office 2013 & above
    #If Win64 Then
    'x64 host
    Private Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" _
    Alias "sndPlaySoundA" (ByVal lpszSoundName _
    As String, ByVal uFlags As LongPtr) As LongPtr
    #Else
    'x86 host
    Private Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" _
    Alias "sndPlaySoundA" (ByVal lpszSoundName _
    As String, ByVal uFlags As Long) As Long
    #End If
#Else
'Office 2010 & under:
    Private Declare Function sndPlaySound32 Lib "winmm.dll" _
    Alias "sndPlaySoundA" (ByVal lpszSoundName _
    As String, ByVal uFlags As Long) As Long
#End If
  
1
2
3
4
5
 
Sub SndPly()
 
    Call sndPlaySound32("C:\windows\media\chord.wav", 1)

End Sub
 

PlaySoundA

引用 winmm.dll 的PlaySoundA

參數1 lpszName

檔案路徑

參數2 hModule

必須是0

參數3 dwFlags

SND_ASYNC 異步/非同步 ，也可以用1，播放開始後即往下執行 SND_SYNC 同步，也可以用0，播放完了才往下執行 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
 
#If VBA7 Then
'Office 2013 & above
    #If Win64 Then
    'x64 host
    Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
    Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As LongPtr, ByVal dwFlags As LongPtr) As LongPtr
    #Else
    'x86 host
    Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
    Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
    #End If
#Else
'Office 2010 & under:
    Private Declare Function PlaySound Lib "winmm.dll" _
    Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
#End If
  
1
2
3
4
5
 
Sub Ply()
 
    Call PlaySound("C:\windows\media\chord.wav", 0, 1)

End Sub
 

在工作簿的應用

自訂function beepFn()呼叫程序 
1
2
3
4
5
 
Function beeFn()
 
    Call sndPlaySound32("C:\windows\media\chord.wav", 1)

End Function
  在公式引用 自訂function beepFn() 
E2=IF(AND(C2<>"",C3 <>""),IF(C2=C3,"PASS","FAIL" & beepFn()),"")

缺點：因為是在公式裡引用，所以開啟檔案的時候會自動執行一次

備註1：關於程式路徑

cmd.exe 無論在Shell函數還是WScript.Shell 都可以省略路徑 而wmplayer.exe在WScript.Shell可以省略路徑，但是在Shell函數必須有完整路徑 這應該是跟環境參數的設定有關

備註2：關於同步/非同步

Shell函數只能非同步執行，也就是執行之後，不會等執行結束，程序就會立即接著執行後面的程式碼 WScript.Shell 、sndPlaySoundA、PlaySoundA，都可以設定同步/非同步

參考資料

VBS中WScript.Shell对象的run和exec的使用及区别 VBA关于声音的多种实现方法 

2024年1月8日 星期一

VBA / 使用Excel VBA插入圖檔

這個是在Line Excel VBA社群的問題 發問者提供了操作影片跟檔案，所以可以很好理解所遇到的問題
  
 原始檔案利用VBA寫了兩個程序   檔案一開始就存在的圖檔可以刪除 後來新增的圖檔卻不能刪除 研究了一下

發現這是圖檔類型(MsoShapeType)的問題

程式碼是利用 Sheet.Pictures.Insert()方法插入的圖片 圖檔類型是msoLinkedPicture 但是檔案一開始就存在的圖片應該是在工作表透過插入/圖片的方式 這樣圖檔類型會是msoPicture 從名稱就可以看出差別 前者是連結圖檔而已，所以當圖檔改變名稱或位置時 工作表就會讀不到圖檔

單就無法刪除圖檔的問題，只需要多一個條件就可以了

原始程式碼只有判別 msoPicture 
1
2
3
 
For Each a In ActiveSheet.Shapes
        If a.Type = msoPicture Then a.Delete
Next
  增加另一個 msoLinkedPicture的條件 
1
2
3
 
For Each a In ActiveSheet.Shapes
        If a.Type = msoPicture Or a.Type = msoLinkedPicture Then a.Delete
Next
 

但是比較好的方式是將匯入程式碼改為利用 Sheet.Shapes.AddPicture()

AddPicture (FileName、 LinkToFile、 SaveWithDocument、 Left、 Top、 Width、 Height) 而且這個方式也可以在參數設定時，設定成以連結方式讀取圖檔 原始程式碼 工作表的B欄儲存檔案名稱，而圖檔跟工作簿是放在同一個資料夾內 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
 
With Sheets("清冊")
	lRow = .[b65536].End(xlUp).Row
	For I = 2 To lRow
	On Error Resume Next
		'strFile = ThisWorkbook.Path & "\" & .Cells(i, 4) & ".jpg"
		strFile = ActiveWorkbook.Path & "\" & .Cells(I, 2) & ".jpg"
		Set oPic = .Pictures.Insert(strFile)
		With .Cells(I, 3)
			oPic.Top = .Top
			oPic.Left = .Left
			oPic.Width = 60
			oPic.Height = 70
		End With
		Set oPic = Nothing
	Next I
End With
  修改後的程式碼 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
 
With Sheets("清冊")
        lRow = .[b65536].End(xlUp).Row
        For I = 2 To lRow
        On Error Resume Next
            'strFile = ThisWorkbook.Path & "\" & .Cells(i, 4) & ".jpg"
'            strFile = "C:\Users\trico\Pictures" & "\" & .Cells(I, 2) & ".jpg"
            strFile = ActiveWorkbook.Path & "\" & .Cells(I, 2) & ".jpg"
            Set oPic = .Shapes.AddPicture(strFile, msoFalse, msoTrue, Cells(I, 3).Left + 2, Cells(I, 3).Top + 1, 120, 70)
            Set oPic = Nothing
        Next I
End With
  補充 當 LinkToFile 為msoFalse時， SaveWithDocument必須為msoTrue，插入的圖檔類型為 msoPicture 但是LinkToFile 為msoTrue時， SaveWithDocument無論是msoTrue或msoFalse，插入的圖檔類型都是 msoLinkedPicture

備註1

比較奇怪的點，同樣的圖片寬度設定，使用Shapes.AddPicture()插入的圖檔大小只有Pictures.Insert()的一半 所以在 Shapes.AddPicture()的寬度設定為Pictures.Insert()的2倍 (60→120) 不過後來發現在 Pictures.Insert()的寬度跟高度只要擇一設定就好了 現在的圖檔是會以高度等比例調整寬度，所以最終寬度其實不是60

備註2

Pictures.Insert()找不到官方的說明資料 找到的都是教學類或者論壇的使用範例 vba插入圖片問題 VBA help for a Macro (inserting picture from file)