VBA/Excel/Access/Word/Windows API/Windows API
Версия от 19:33, 26 мая 2010; (обсуждение)
Содержание
Declaring an External Function to the Compiler
<source lang="vb">
Declare Function abGetSystemDirectory _
Lib "kernel32" _ Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) _ As Long
Sub WinSysDir()
Dim strBuffer As String Dim intLength As Integer Dim strDirectory As String strBuffer = Space$(160) intLength = abGetSystemDirectory(strBuffer, Len(strBuffer)) strDirectory = Left(strBuffer, intLength) MsgBox strDirectory
End Sub
</source>
Playing .Wav files via the Windows API
<source lang="vb">
Public Declare Function sndPlaySoundA Lib "winmm.dll" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long Public Sub PlayWav(WavFile As String)
If Application.CanPlaySounds = False Then MsgBox "Sorry, sound is not supported on your system." Exit Sub End If If Dir(WavFile) = "" Then MsgBox ("Wave file not found") Exit Sub End If sndPlaySoundA WavFile, 1
End Sub Public Sub TestPlayWav1()
Dim filePath As String filePath = ActiveWorkbook.Path PlayWav (filePath & "\Sounds\cannon.wav")
End Sub
</source>
Use 32-bit API declaration
<source lang="vb">
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Public Const SM_CXSCREEN = 0 Public Const SM_CYSCREEN = 1 Sub DisplayVideoInfo()
vidWidth = GetSystemMetrics(SM_CXSCREEN) vidHeight = GetSystemMetrics(SM_CYSCREEN) Debug.Print vidWidth & " X " & vidHeight
End Sub
</source>
Using a Function in a DLL
<source lang="vb"> Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Public Const SM_SWAPBUTTON = 23 Sub ShowHands() If GetSystemMetrics(SM_SWAPBUTTON) = False Then MsgBox "Your mouse is right-handed!" Else MsgBox "Your mouse is left-handed!" End If End Sub </source>
Waiting for an application to end
<source lang="vb">
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long Sub RunCharMap2()
Dim TaskID As Long Dim hProc As Long Dim lExitCode As Long ACCESS_TYPE = &H400 STILL_ACTIVE = &H103 Program = "Charmap.exe" TaskID = Shell(Program, 1) hProc = OpenProcess(ACCESS_TYPE, False, TaskID) If Err <> 0 Then Debug.Print "Cannot start " & Program, vbCritical, "Error" Exit Sub End If Do GetExitCodeProcess hProc, lExitCode DoEvents Loop While lExitCode = STILL_ACTIVE
End Sub
</source>