006集——#If...Then...#Else 指令的作用与 If...Then...Else 语句——VBA
#If...Then...#Else 指令
条件编译已选择的 Visual Basic 代码块。
语法
#If expression Then
statements
#ElseIf expression-n Then
[elseifstatements]
#Else
elsestatements
#End If
#If...Then...#Else 指令的语法具有以下几个部分：
| 部分 | 描述 |
|---|---|
| expression | 必要。包含一个或多个条件编译常数、文字与运算符的任何表达式，其值为 True 或 False。 |
| statements | 必要。Visual Basic 程序行或编译指令，如果关联的表达式为 True，则运行它们。 |
| expression-n | 可选。由一或多个条件编译常数、文字和运算符组成的任何一个表达式，其值为 True 或 False。 |
| elseifstatements | 可选。一个或多个程序行或编译命令，如果 expression-n 为 True，则运行它们。 |
| elsestatements | 可选。一个或多个程序行或编译命令，如果以前的expression 或 expression-n 中没有一个为 True，则运行它们。 |
#If...Then...#Else 指令的作用与 If...Then...Else 语句相同，其差异在于 #If、#Else、#ElseIf，及 #End If 指令没有单独成行的形式，也就是说，在指令所在的那一行，不能有其他代码出现。条件编译通常用来编译不同平台上的同一个程序。也可以用来避免调试程序代码出现在可执行程序中。条件编译时被排除的程序代码在最后的可执行文件中被完全略去，所以不会对程序的大小或功能有任何影响。
无论结果如何，都要计算所有表达式。所以，在表达式中用到的所有常数都必须加以定义— 任何未定义的常数都会被当作 Empty 来计算取值。
注意 Option Compare 语句不会影响 #If 及 #ElseIf 语句中的表达式。条件编译指令中的表达式总是用 Option Compare Text 计算值。
例如，vba7和vba6为不同的idea环境，一个程序如要同时可在两个环境运行，则用到#if 判断平台，然后选择不同的代码进行执行，否则可能会报错。
如下：
#If VBA7 Then
Private Declare PtrSafe Function ts_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
Private Declare PtrSafe Function ts_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
Private Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As LongPtr
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Type BROWSEINFO
hOwner As LongPtr
pidlRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As LongPtr
lpfn As LongPtr
lParam As LongPtr
iImage As LongPtr
End Type
Private Type tsFileName
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As LongPtr
lpTemplateName As String
End Type
' Flag Constants
Private Const tscFNAllowMultiSelect = &H200
Private Const tscFNCreatePrompt = &H2000
Private Const tscFNExplorer = &H80000
Private Const tscFNExtensionDifferent = &H400
Private Const tscFNFileMustExist = &H1000
Private Const tscFNPathMustExist = &H800
Private Const tscFNNoValidate = &H100
Private Const tscFNHelpButton = &H10
Private Const tscFNHideReadOnly = &H4
Private Const tscFNLongNames = &H200000
Private Const tscFNNoLongNames = &H40000
Private Const tscFNNoChangeDir = &H8
Private Const tscFNReadOnly = &H1
Private Const tscFNOverwritePrompt = &H2
Private Const tscFNShareAware = &H4000
Private Const tscFNNoReadOnlyReturn = &H8000
Private Const tscFNNoDereferenceLinks = &H100000
Public Function GOFN( _
Optional ByRef rlngflags As Long = 0&, _
Optional ByVal strInitialDir As String = "", _
Optional ByVal strFilter As String = "dwg文件 (*.dwg)" & vbNullChar & "*.dwg" _
& vbNullChar & "All Files (*.*)" & vbNullChar & "*.*", _
Optional ByVal lngFilterIndex As Long = 1, _
Optional ByVal strDefaultExt As String = "", _
Optional ByVal strFileName As String = "", _
Optional ByVal strDialogTitle As String = "", _
Optional ByVal fOpenFile As Boolean = True) As Variant
'On Error GoTo GOFN_Err
Dim tsFN As tsFileName
Dim strFileTitle As String
Dim fResult As Boolean
' Allocate string space for the returned strings.
strFileName = Left(strFileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With tsFN
.lStructSize = LenB(tsFN)
'.hwndOwner = Application.hWndAccessApp
.strFilter = strFilter
.nFilterIndex = lngFilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = strDialogTitle
.flags = rlngflags
.strDefExt = strDefaultExt
.strInitialDir = strInitialDir
.hInstance = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
.lpfnHook = 0
End With
' Call the function in the windows API
fResult = ts_apiGetOpenFileName(tsFN)
If fResult Then
rlngflags = tsFN.flags
GOFN = tsTrimNull(tsFN.strFile)
Else
GOFN = Null
MsgBox "您未选择"
End
End If
End Function
Public Function GSFN( _
Optional ByRef rlngflags As Long = 0&, _
Optional ByVal strInitialDir As String = "", _
Optional ByVal strFilter As String = "dwg文件 (*.dwg)" & vbNullChar & "*.dwg" _
& vbNullChar & "All Files (*.*)" & vbNullChar & "*.*", _
Optional ByVal lngFilterIndex As Long = 1, _
Optional ByVal strDefaultExt As String = "", _
Optional ByVal strFileName As String = "", _
Optional ByVal strDialogTitle As String = "", _
Optional ByVal fOpenFile As Boolean = False) As Variant
'On Error GoTo tsGetFileFromUser_Err
Dim tsFN As tsFileName
Dim strFileTitle As String
Dim fResult As Boolean
' Allocate string space for the returned strings.
strFileName = Left(strFileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With tsFN
.lStructSize = LenB(tsFN)
'.hwndOwner = Application.hWndAccessApp
.strFilter = strFilter
.nFilterIndex = lngFilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = strDialogTitle
.flags = rlngflags
.strDefExt = strDefaultExt
.strInitialDir = strInitialDir
.hInstance = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
.lpfnHook = 0
End With
fResult = ts_apiGetSaveFileName(tsFN)
If fResult Then
rlngflags = tsFN.flags
GSFN = tsTrimNull(tsFN.strFile)
Else
GSFN = Null
MsgBox "您未保存"
End
End If
End Function
' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_Err
Dim I As Integer
I = InStr(strItem, vbNullChar)
If I > 0 Then
tsTrimNull = Left(strItem, I - 1)
Else
tsTrimNull = strItem
End If
tsTrimNull_End:
On Error GoTo 0
Exit Function
tsTrimNull_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsTrimNull"
Resume tsTrimNull_End
End Function
Public Function GOFOLDER() As String
On Error GoTo Err_GOFOLDER
Dim x As LongPtr, bi As BROWSEINFO, dwIList As LongPtr
Dim szPath As String, wPos As Integer
With bi
'.hOwner = hWndAccessApp
.lpszTitle = "请选择文件夹"
.ulFlags = BIF_RETURNONLYFSDIRS
End With
dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
If x Then
wPos = InStr(szPath, Chr(0))
GOFOLDER = Left$(szPath, wPos - 1)
Else
GOFOLDER = ""
MsgBox "您未选择"
End
End If
Exit_GOFOLDER:
Exit Function
Err_GOFOLDER:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_GOFOLDER
End Function
#Else
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (lpofn As OPENFILENAME) As Long
Declare Function SHBrowseForFolder Lib "SHELL32.DLL" (lpBrowseInfo As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public choice As String
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Function GOFOLDER(Optional message) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0
bInfo.lpszTitle = "请选择待处理数据所在的文件夹"
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(256)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr(0))
GOFOLDER = Left(path, pos - 1)
Else
GOFOLDER = ""
MsgBox "您未选择"
End
End If
End Function
Function GOFN() As String
Dim sOFN As OPENFILENAME
With sOFN
.lStructSize = Len(sOFN)
.lpstrFilter = "dwg文件(*.dwg)" & Chr(0) & "*.dwg" & Chr(0) & "dxf文件(*.dxf)" & Chr(0) & "*.dxf" & Chr(0) & "Excel文件(*.xl*)" & Chr(0) & "*.xl*" & Chr(0) & "Word文件(*.do*)" _
& Chr(0) & "*.do*" & Chr(0) & "PPT文件(*.pp*)" & Chr(0) & "*.pp*" & Chr(0) & "所有文件(*.*)" & Chr(0) & "*.*" _
& Chr(0) & Chr(0)
.lpstrFile = Space(1024)
.nMaxFile = 1025
End With
Dim sFileName As String
If GetOpenFileName(sOFN) <> 0 Then
With sOFN
sFileName = Trim(.lpstrFile)
GOFN = Left(sFileName, Len(sFileName) - 1)
End With
Else
GOFN = ""
MsgBox "您已取消，请重新选择"
End
End If
End Function
Function GSFN() As String
Dim sSFN As OPENFILENAME
With sSFN
.lStructSize = Len(sSFN)
'设置保存文件对话框中的文件筛选字符串对
.lpstrFilter = "dwg文件(*.dwg)" & Chr(0) & "*.dwg" & Chr(0) & "dxf文件(*.dxf)" & Chr(0) & "*.dxf" & Chr(0) & "Excel文件(*.xl*)" & Chr(0) & "*.xl*" & Chr(0) & "Word文件(*.do*)" _
& Chr(0) & "*.do*" & Chr(0) & "PPT文件(*.pp*)" & Chr(0) & "*.pp*" & Chr(0) & "所有文件(*.*)" & Chr(0) & "*.*" _
& Chr(0) & Chr(0)
'设置文件完整路径和文件名的缓冲区
.lpstrFile = Space(1024)
'设置文件完整路径和文件名的最大字符数,一定要比lpstrFile参数指定的字符数多1，用于存储结尾Null字符
.nMaxFile = 1025
End With
Dim sFileName As String
If GetSaveFileName(sSFN) <> 0 Then
With sSFN
sFileName = Trim(.lpstrFile)
GSFN = Left(sFileName, Len(sFileName) - 1)
End With
Else
GSFN = ""
MsgBox "您已取消，请重新选择"
End
End If
' Debug.Print GSFN, Len(GSFN)
End Function
#End If