VBA教程
Excel VBA自定义函数MYSTR()指定连接符连接文本
字符串处理一直是Excel函数的软肋，动不动就需要多层嵌套，数组公式，有些功能还无法实现，比如用连接符连接文本，用函数几乎是无法做到的，有了VBA自定义函数，这一切将SO EASY！ 下面就为大家分享一个简单的字符串连接处理函数：
如何在Excel 2013/2016中清除或禁用最近的工作簿列表
本文讲述如何在Excel 2013/2016中清除或禁用最近的工作簿列表。如何在Microsoft Excel中使用VBA宏清除“最近使用的工作簿”列表。使用Excel查看或打开Excel工作簿时，您会发现它通常显示最近访问的工作簿列表。此列表可以帮助您快速打开最近使用的工作簿。但是，您可能不希望其他人也看到你最难操作过的工作簿列表。您想要从最近的列表中清除或禁用最近的工作簿列表。这篇文章将向您展示清除最近工作簿列表的三种方法。步骤1：转到“文件”选项卡，单击“选项”菜单，然后将打开“Excel选项”对话框。步骤2：在“Excel选项”对话框的左窗格中单击“高级”，然后向下滚动到“显示”部分，找到“显示此数目的”最近使用的工作簿“”项，并在文本框中输入数字0。步骤3：单击“确定”按钮。然后转到文件 – >打开 – >最近，您应该看到最近的工作簿列表已被清除。您还可以使用“清除已取消固定的工作簿”命令清除“最近使用的工作簿”中的所有工作簿项。只需执行以下步骤：步骤1：转到“文件”选项卡，单击左窗格中的“打开”菜单。然后单击右窗格中的“最近”菜单。
在不同版本 Excel 中插入图片 VBA代码
我们在Excel中插入图片一般使用Picture集合的Insert方法。但是随着Excel版本的演进，在不同的版本指间插入图片还是有一些差别。下面是Excel2003中的代码。其中Insert方法中的文件路径的文件夹分界符可以是”\”也可以是”/”。另外，设置LoctAspecRatio属性为True并不能固定长宽比，需要同时调整长度和宽度。SubInsertImg2003()DimimgWidthAsIntegerDimfixWidthAsIntegerDimdRatioAsDouble'设置图片显示固定宽度fixWidth=Cells(2，2)。Width*5'选择图片插入位置Cells(2，2)。Select
Excel VBA 窗体之去除窗体关闭按钮 实现代码
VBA的窗体缺少一般窗体的很多属性，不想许多语言窗体那样可以自由的设置窗体的样式，就连其默认的关闭按钮也不能设置为不显示，一般的处理方法是在窗体的关闭事件中添加代码来阻止窗体的关闭。那还不如就直接运用代码来把他去除掉(如图)。附件下载：点击链接从百度网盘下载操作如下：◾在Excel的VBE窗口中插入一个用户窗体，将其命名为frmNoCloseIcon。然后再添加一个模块。在窗体和模块中添加后面所列代码。◾在工作薄中的任意工作表中添加一窗体按钮控件，将指定其设置宏为btnShowfrmMaxMin_Click。其供示范之用。具体代码："mdClose"模块代码 Sub btnShowfrmMaxMin_Click() frmNoCloseIcon.Show End Sub
Excel VBA 窗体之去除窗体标题栏 实现代码
在VBA中当我们有时需要显示一个无标题栏的窗体作为启动的界面，但是VBA的窗体不可以直接设置这样的属性，只有通过代码来实现附件下载：点击链接从百度网盘下载操作如下：◾在Excel的VBE窗口中插入一个用户窗体，将其命名为DelTitleForm。在用户窗体中添加两个按钮，将其分别更名为和BtCancel。然后再添加一个模块。在窗体和模块中添加后面所列代码。◾在工作薄中的任意工作表中添加一窗体按钮控件，将指定其设置宏为ShowForm。其供示范之用具体代码："mdNoTitle"模块代码 Sub ShowForm() DelTitleForm.Show End Sub
Excel VBA 操作注册表的模块 实现代码
VBA 自带的注册表操作功能很弱，只能操作固定的键，很是不方便。这里收集了一个在 VBA 中操作注册表的模块，我对模块进行了一定的修改，使它可以用在 64 位的 Office 上面。Option Explicit'---注册表主键--- Public Enum enumRegMainKey iHKEY_CLASSES_ROOT = &H80000000 iHKEY_CURRENT_USER = &H80000001 iHKEY_LOCAL_MACHINE = &H80000002 iHKEY_USERS = &H80000003 iHKEY_PERFORMANCE_DATA = &H80000004 iHKEY_CURRENT_CONFIG = &H80000005 iHKEY_DYN_DATA = &H80000006 End Enum '---注册表数据类型--- Public Enum enumRegSzType iREG_SZ = &H1 iREG_EXPAND_SZ = &H2 iREG_BINARY = &H3 iREG_DWORD = &H4 iREG_NONE = 0& iREG_DWORD_LITTLE_ENDIAN = 4& iREG_DWORD_BIG_ENDIAN = 5& iREG_LINK = 6& iREG_MULTI_SZ = 7& iREG_RESOURCE_LIST = 8& iREG_FULL_RESOURCE_DEscrīptOR = 9& iREG_RESOURCE_REQUIREMENTS_LIST = 10& End Enum'---返回值和访问权限常数--- Private Const ERROR_SUCCESS = 0& Private Const ERROR_BADDB = 1009& Private Const ERROR_BADKEY = 1010& Private Const ERROR_CANTOPEN = 1011& Private Const ERROR_CANTREAD = 1012& Private Const ERROR_CANTWRITE = 1013& Private Const ERROR_OUTOFMEMORY = 14& Private Const ERROR_INVALID_PARAMETER = 87& Private Const ERROR_ACCESS_DENIED = 5& Private Const ERROR_NO_MORE_ITEMS = 259& Private Const ERROR_MORE_DATA = 234& Private Const KEY_QUERY_VALUE = &H1& Private Const KEY_SET_VALUE = &H2& Private Const KEY_CREATE_SUB_KEY = &H4& Private Const KEY_ENUMERATE_SUB_KEYS = &H8& Private Const KEY_NOTIFY = &H10& Private Const KEY_CREATE_LINK = &H20& Private Const SYNCHRONIZE = &H100000 Private Const READ_CONTROL = &H20000 Private Const WRITE_DAC = &H40000 Private Const WRITE_OWNER = &H80000 Private Const STANDARD_RIGHTS_REQUIRED = &HF0000 Private Const STANDARD_RIGHTS_READ = READ_CONTROL Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE)) Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))'---API 函数--- #If Win64 Then '64位 Private Declare PtrSafe Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, phkResult As LongPtr) As Long Private Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As LongPtr, lpdwDisposition As Long) As Long Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, lpType As Long, lpData As Byte, lpcbData As Long) As Long Private Declare PtrSafe Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As LongPtr, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long Private Declare PtrSafe Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As LongPtr, ByVal lpValueName As String) As Long Private Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value. Private Declare PtrSafe Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As LongPtr, ByVal cbData As LongPtr) As Long Private Declare PtrSafe Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As LongPtr, ByVal cbData As LongPtr) As Long Private Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value. Private Declare PtrSafe Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As LongPtr, ByVal lpSubKey As String) As Long Private Declare PtrSafe Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As LongPtr, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long Private Declare PtrSafe Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As LongPtr, ByVal lpFile As String, ByVal dwFlags As Long) As Long #Else Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Long, ByVal cbData As Long) As Long Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal lpSecurityAttributes As Long) As Long Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwflags As Long) As Long #End IfPrivate Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type#If Win64 Then '64位 Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescrīptor As LongPtr bInheritHandle As Boolean End Type #Else Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type #End If'---取得值--- Public Function GetValue(ByVal mainKey As enumRegMainKey, _ ByVal subKey As String, _ ByVal keyV As String, _ ByRef sValue As Variant, _ Optional ByRef rlngErrNum As Long, _ Optional ByRef rstrErrDescr As String) As Boolean Dim hKey As Long, lType As Long, lBuffer As Long, sBuffer As String, lData As Long On Error GoTo GetValueErr GetValue = False If RegOpenKeyEx(mainKey, subKey, 0, KEY_READ, hKey) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "获取注册表值时出错" End If If RegQueryValueEx(hKey, keyV, 0, lType, ByVal 0, lBuffer) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "获取注册表值时出错" End If Select Case lType Case iREG_SZ lBuffer = 255 sBuffer = Space(lBuffer) If RegQueryValueEx(hKey, keyV, 0, lType, ByVal sBuffer, lBuffer) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "获取注册表值时出错" End If sValue = Left(sBuffer, InStr(sBuffer, Chr(0)) - 1) Case iREG_EXPAND_SZ sBuffer = Space(lBuffer) If RegQueryValueEx(hKey, keyV, 0, lType, ByVal sBuffer, lBuffer) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "获取注册表值时出错" End If sValue = Left(sBuffer, InStr(sBuffer, Chr(0)) - 1) Case iREG_DWORD If RegQueryValueEx(hKey, keyV, 0, lType, lData, lBuffer) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "获取注册表值时出错" End If sValue = lData Case iREG_BINARY If RegQueryValueEx(hKey, keyV, 0, lType, lData, lBuffer) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "获取注册表值时出错" End If sValue = lData End Select If RegCloseKey(hKey) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "获取注册表值时出错" End If GetValue = True Err.Clear GetValueErr: rlngErrNum = Err.Number rstrErrDescr = Err.Descrīption End Function'----赋值--- Public Function SetValue(ByVal mainKey As enumRegMainKey, _ ByVal subKey As String, _ ByVal keyV As String, _ ByVal lType As enumRegSzType, _ ByVal sValue As Variant, _ Optional ByRef rlngErrNum As Long, _ Optional ByRef rstrErrDescr As String) As Boolean Dim S As Long, lBuffer As Long, hKey As Long Dim ss As SECURITY_ATTRIBUTES On Error GoTo SetValueErr SetValue = False ss.nLength = Len(ss) ss.lpSecurityDescrīptor = 0 ss.bInheritHandle = True If RegCreateKeyEx(mainKey, subKey, 0, "", 0, KEY_WRITE, ss, hKey, S) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "设置注册表时出错" End If Select Case lType Case iREG_SZ lBuffer = LenB(sValue) If RegSetValueEx(hKey, keyV, 0, lType, ByVal sValue, lBuffer) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "设置注册表时出错" End If Case iREG_EXPAND_SZ lBuffer = LenB(sValue) If RegSetValueEx(hKey, keyV, 0, lType, ByVal sValue, lBuffer) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "设置注册表时出错" End If Case iREG_DWORD lBuffer = 4 If RegSetValueExA(hKey, keyV, 0, lType, sValue, lBuffer) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "设置注册表时出错" End If Case iREG_BINARY lBuffer = 4 If RegSetValueExA(hKey, keyV, 0, lType, sValue, lBuffer) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "设置注册表时出错" End If Case Else Err.Raise vbObjectError + 1, , "不支持该参数类型" End Select If RegCloseKey(hKey) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "设置注册表时出错" End If SetValue = True Err.Clear SetValueErr: rlngErrNum = Err.Number rstrErrDescr = Err.Descrīption End Function'---删除值--- Public Function DeleteValue(ByVal mainKey As enumRegMainKey, _ ByVal subKey As String, _ ByVal keyV As String, _ Optional ByRef rlngErrNum As Long, _ Optional ByRef rstrErrDescr As String) As Boolean Dim hKey As Long On Error GoTo DeleteValueErr DeleteValue = False If RegOpenKeyEx(mainKey, subKey, 0, KEY_WRITE, hKey) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "删除注册表值时出错" End If If RegDeleteValue(hKey, keyV) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "删除注册表值时出错" End If If RegCloseKey(hKey) <> ERROR_SUCCESS Then Err.Raise vbObjectError + 1, , "删除注册表值时出错" End If DeleteValue = True Err.Clear DeleteValueErr: rlngErrNum = Err.Number rstrErrDescr = Err.Descrīption End Function
Excel VBA 中定时关闭的 MsgBox 一个未公开的API
了解 VBA 的朋友们都知道，VBA 中自带的 MsgBox 不能自动关闭，需要用户做出交互后才能关闭。但是在某些特定情况下，我们需要 Msgbox 在指定时间内没有用户操作的情况下自动关闭，然后继续运行代码。一般采取的方法是使用Wscript.Shell 的 Popup 方法，或者自定义窗体， 或者采用 SetTimer 等来实现。这里推荐一个未公开的 API 函数—— MessageBoxTimeout 实现定时关闭消息框，感觉十分有用, 这里为了方便我们把它的名称声明为 MsgBoxTimeout，将 wType 声明为 VbMsgBoxStyle。函数的声明如下(32位)：Private Declare Function MsgBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" ( _ ByVal hwnd As Long, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As VbMsgBoxStyle, _ ByVal wlange As Long, _ ByVal dwTimeout As Long) As Long此函数的参数如下： ◾hwnd：消息框拥有者窗口的句柄，可以设为 0 ◾lpText：消息框显示内容，类似于 MsgBox 函数的第一个参数 Prompt ◾lpCaption：消息框标题，类似于 MsgBox 函数的第三个参数 Caption ◾wType：消息框类型，类似于 MsgBox 函数的第二个参数 Buttons ◾wlange：函数扩展，一般取 0 ◾dwTimeout：消息框延迟关闭时间，单位为毫秒 返回的值和 vbMsgBoxResult 常数一样，多了一个返回值 32000 表示超过延时时间未选择任何按钮。具体例子见附件：点击链接从百度网盘下载示例代码如下： '**************************************** '---此模块演示一个可以延时关闭的消息框--- '**************************************** #If Win64 Then '64位 Private Declare PtrSafe Function MsgBoxTimeout _ Lib "user32" _ Alias "MessageBoxTimeoutA" ( _ ByVal hwnd As LongPtr, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As VbMsgBoxStyle, _ ByVal wlange As Long, _ ByVal dwTimeout As Long) _ As Long #Else Private Declare Function MsgBoxTimeout _ Lib "user32" _ Alias "MessageBoxTimeoutA" ( _ ByVal hwnd As Long, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As VbMsgBoxStyle, _ ByVal wlange As Long, _ ByVal dwTimeout As Long) _ As Long #End If Sub btnMsgbox_Click() Dim xRet As Long xRet = MsgBoxTimeout(0, "此对话框如无交互操作将在 2 秒后自动关闭", "ExcelFans.com", vbYesNo + vbInformation, 1, 2000) Select Case xRet Case 32000 Debug.Print "超时自动关闭" Case vbYes Debug.Print "选择""是""按钮" Case vbNo Debug.Print "选择""否""按钮" End Select End Sub
如何实现 Excel 文件执行完代码后把自身给删除了
有朋友需要一些另类的功能，比如让一个 Excel 文件执行完代码后把自身给删除了，其实 Excel 还真的可以做到，这是一段网上摘抄的代码， 可以让一个工作簿执行完代码后自己删除自己.附件下载：点击从百度网盘下载 具体代码：Sub CloseSelf() Application.DisplayAlerts = False ThisWorkbook.ChangeFileAccess xlReadOnly MsgBox "点击确定按钮我就把自己删除了哟 ^_^" Kill ThisWorkbook.FullName ThisWorkbook.Close False End Sub
Excel VBA 添加自定义函数的参数描述
在Excel 2010 发布之前，用户已经可以为自定义函数(User-Defined Function)添加一系列的信息，比如描述等等。但是无法用常规的手段为自定义函数的参数添加描述信息。Excel 2010 及以后版本这个问题得到了解决。微软改进了 VBA 中 Application 对象的 MacroOptions 方法——在原来的基础上添加了一个 ArgumentDescriptions 参数，利用此参数就可以为用户自定义函数添加描述信息了。以下给出一个具体例子来说明这个方法的具体应用，将后列的代码复制到一个标准模块中，然后执行其中的 RegUDF 过程，你就可以在 Excel 中使用 FunArgDes 函数了具体代码：'用户自定义函数 Function FunArgDes(int1 As Integer, int2 As Integer) As Integer FunArgDes = int1 + int2 End Function '此过程用户注册自定义函数 Sub RegUDF() Dim FuncName As String '函数名称 Dim FuncDesc As String '函数描述 Dim Category As String '函数类别 Dim ArgDesc(1) As String '函数参数描述数组 FuncName = "FunArgDes" FuncDesc = "返回两个整数的和(测试函数参数描述)" Category = "函数参数描述测试" ArgDesc(0) = "函数参数第一个，整型" ArgDesc(1) = "函数参数第二个，整型" Call Application.MacroOptions(Macro:=FuncName, Description:=FuncDesc, Category:=Category, ArgumentDescriptions:=ArgDesc) End Sub
excel VBA 窗体之拖动边界改变大小窗体 实现代码
我们已经有了一系列怎样增强 VBA 窗体的文章，VBA 的窗体和一般正常的窗体区别很大，比如就不可以通过用鼠标拖动窗体的边框，我们今天就讲讲怎样给 VBA 窗体添加这个功能。操作如下： ◾在Excel 的VBE窗口中插入一个用户窗体，将其命名为 frmNotEnabledCloseIcon。然后再添加一个模块。在窗体和模块中添加后面所列代码。 ◾在工作薄中的工作表中添加一窗体按钮控件，指定其设置宏 ShowNotEnabledCloseIconForm, 其供示范之用. 具体代码： "frmThickFram" 窗体代码'******************************** '---此模块演示怎样删除窗体标题栏---www.office26.com '******************************** '以下声明API函数 #If Win64 Then '64位 '取得窗体样式位 Private Declare PtrSafe Function GetWindowLong _ Lib "user32" _ Alias "GetWindowLongPtrA" ( _ ByVal Hwnd As LongPtr, _ ByVal nIndex As Long) _ As LongPtr '查找窗口 Private Declare PtrSafe Function FindWindow _ Lib "user32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) _ As LongPtr '设置窗体样式位 Private Declare PtrSafe Function SetWindowLong _ Lib "user32" _ Alias "SetWindowLongPtrA" ( _ ByVal Hwnd As LongPtr, _ ByVal nIndex As Long, _ ByVal dwNewLong As LongPtr) _ As LongPtr '绘制窗体标题栏 Private Declare PtrSafe Function DrawMenuBar _ Lib "user32" ( _ ByVal Hwnd As LongPtr) _ As Long #Else '取得窗体样式位 Private Declare Function GetWindowLong _ Lib "user32" _ Alias "GetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long) _ As Long '查找窗口 Private Declare Function FindWindow _ Lib "user32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) _ As Long '设置窗体样式位 Private Declare Function SetWindowLong _ Lib "user32" _ Alias "SetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) _ As Long '绘制窗体标题栏 Private Declare Function DrawMenuBar _ Lib "user32" ( _ ByVal hwnd As Long) _ As Long #End If #If Win64 Then '64位 Private hWndForm As LongPtr Private FIstype As LongPtr #Else Private hWndForm As Long Private FIstype As Long #End If '以下定义常数和变量 Private Const GWL_STYLE = (-16) '窗口样式 Private Const WS_THICKFRAME = &H40000 '可更改大小 '---关闭按钮--- Private Sub btnClose_Click() Unload Me End Sub '---窗体初始化--- Private Sub UserForm_Initialize() On Error Resume Next '查找窗体句柄 hWndForm = FindWindow("ThunderDFrame", Me.Caption) '取得窗体样式 FIstype = GetWindowLong(hWndForm, GWL_STYLE) '窗体样式：原样式和可拖动边框改变大小 FIstype = FIstype Or WS_THICKFRAME '重设窗体样式 SetWindowLong hWndForm, GWL_STYLE, FIstype '重绘窗体标题栏 DrawMenuBar hWndForm End Sub"mdThickfram" 模块代码Option Explicit ' 此过程为工作表内按钮调用 Sub ShowThickFramForm() frmThickFram.Show End Sub