Excel VBA 部分自定义函数代码

☆本期内容概要☆

• 用户窗体设置：部分自定义函数代码

'***************************↓使得ListView可编辑相关代码↓*********************************
Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr) As LongPtrPublic Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr, ByVal dwNewLong As LongPtr) As LongPtrPublic Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtrPublic Const WM_HSCROLL = &H114Public Const WM_VSCROLL = &H115Public Const WM_MOUSEWHEEL = &H20APublic Const GWL_WNDPROC = (-4)Public LvmPreWndProc As LongPtrPublic InkPreWndProc As LongPtrPublic blnChangeUser As Boolean
'自定义窗口程序，拦截我们需要的系统消息，然后按我们需要的方式处理消息。'注意：一定要把你无需处理的消息移交给原窗口程序处理，不然窗口会“罢工”Public Function WndProc(ByVal hwnd As LongPtr, ByVal Msg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr    Dim currUserForm As UserForm    If IsFormActive("Usf_AddAndModify") Then                Set currUserForm = Usf_AddAndModify    ElseIf IsFormActive("Usf_AddAndModify2") Then                Set curruserfor = Usf_AddAndModify2    End If    With currUserForm                Select Case hwnd        Case .LvDetail.hwnd            If Msg = WM_VSCROLL Or Msg = WM_HSCROLL Then .LvDetail.SetFocus            WndProc = CallWindowProc(LvmPreWndProc, hwnd, Msg, wParam, lParam)        Case .InkEdit1.hwnd            If Msg = WM_MOUSEWHEEL Then .LvDetail.SetFocus            WndProc = CallWindowProc(InkPreWndProc, hwnd, Msg, wParam, lParam)        End Select    End With    End Function
'***************************↑使得ListView可编辑相关代码↑*********************************Function IsFormActive(UsfName As String) As Boolean    Dim i As Integer    For i = 0 To UserForms.Count - 1        IsFormActive = UserForms(i).Name = UsfName        If IsFormActive Then Exit Function    NextEnd Function
Function wContinue(Msg) As Boolean    '确认继续函数    Dim Config As Long    Dim a As Long    Config = vbYesNo + vbDefaultButton2 + vbQuestion    Ans = MsgBox(Msg & Chr(10) & "是(Y)继续?" & Chr(10) & "否(N)返回！", Config, "请确认操作！")     wContinue = Ans = vbYesEnd Function
Function PathSelected()    With Application.FileDialog(msoFileDialogFolderPicker)        If .Show = -1 Then                       'FileDialog 对象的 Show 方法显示对话框            PathSelected = .SelectedItems(1)        Else            Exit Function        End If    End WithEnd Function

---