в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:48:34Z

1 версия

Новая страница

==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>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Windows API/Windows API - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия