我的2000可以啊 这是自动保存加载宏的代码,供参考 Const SZREGPATH As String = "Software\Microsoft\Office\8.0\Excel\" Const HKEY_CLASSES_ROOT As Long = &H80000000
Const HKEY_CURRENT_USER As Long = &H80000001
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const HKEY_USERS As Long = &H80000003 Const ERROR_SUCCESS As Long = 0&
Const ERROR_FILE_NOT_FOUND As Long = 2&
Const ERROR_INVALID_HANDLE As Long = 6&
Const ERROR_NO_ACCESS As Long = 998& Const REG_SZ As Long = 1&
Const REG_DWORD As Long = 4& Private Declare Function D893SD93V& Lib "ADVAPI32" Alias "RegOpenKeyA" (ByVal hkeyOpen&, ByVal szSubKey$, ByRef hkeyResult&)
Private Declare Function Z38B15G& Lib "ADVAPI32" Alias "RegCreateKeyA" (ByVal hkeyOpen&, ByVal szSubKey$, ByRef hkeyResult&)
Private Declare Function CI38X3jb& Lib "ADVAPI32" Alias "RegQueryValueExA" (ByVal hkey&, ByVal szValueName$, ByVal lReserved&, ByRef lType&, ByVal sValue$, ByRef lcbData&)
Private Declare Function R329BXX2& Lib "ADVAPI32" Alias "RegQueryValueExA" (ByVal hkey&, ByVal szValueName$, ByVal lReserved&, ByRef lType&, ByRef lValue&, ByRef lcbData&)
Private Declare Function M38b3325Bz& Lib "ADVAPI32" Alias "RegQueryValueExA" (ByVal hkey&, ByVal szValueName$, ByVal lReserved&, ByRef lType&, ByVal vNull As Any, ByRef lcbData&)
Private Declare Function XX348HJKL& Lib "ADVAPI32" Alias "RegCloseKey" (ByVal hkey&)
Private Declare Function VC839NBmC& Lib "ADVAPI32" Alias "RegSetValueExA" (ByVal hkey&, ByVal szValueName$, ByVal dwReserved&, ByVal lType&, ByVal sValue$, ByVal lcbData&)
Private Declare Function B3139Jsx2& Lib "ADVAPI32" Alias "RegSetValueExA" (ByVal hkey&, ByVal szValueName$, ByVal dwReserved&, ByVal lType&, ByRef lValue&, ByVal lcbData&) Private Function X39f0392vv(szSection$, szKey$, Optional vDefaultValue As Variant) As Variant
On Error GoTo lbl_Error
If IsMissing(vDefaultValue) Then vDefaultValue = CVErr(xlErrNA)
Dim hkey&, lResult&, lcbValue&, szValue$, lValue&
lResult& = D893SD93V&(HKEY_CURRENT_USER, SZREGPATH & szSection$, hkeyXL5&)
If lResult& <> ERROR_SUCCESS Then
RegGetXLValue = vDefaultValue
Exit Function
End If
lResult& = M38b3325Bz&(hkeyXL5&, szKey$, 0&, lType&, 0&, lcbValue&)
If lResult& <> ERROR_SUCCESS Then
RegGetXLValue = vDefaultValue
Exit Function
End If
If lType& = REG_SZ Then
szValue$ = String$(lcbValue&, " ")
lResult& = CI38X3jb&(hkeyXL5&, szKey$, 0&, lType&, szValue$, lcbValue&)
If lResult& <> ERROR_SUCCESS Then
RegGetXLValue = vDefaultValue
Exit Function
End If
RegGetXLValue = Left$(szValue$, lcbValue& - 1)
ElseIf lType& = REG_DWORD Then
lValue& = 0
lResult& = R329BXX2&(hkeyXL5&, szKey$, 0&, lType&, lValue&, lcbValue&)
If lResult& <> ERROR_SUCCESS Then
RegGetXLValue = vDefaultValue
Exit Function
End If
RegGetXLValue = lValue&
End If
lResult& = XX348HJKL&(hkeyXL5&)
If lResult& <> ERROR_SUCCESS Then
RegGetXLValue = vDefaultValue
Exit Function
End If
Exit Function
lbl_Error:
RegGetXLValue = vDefaultValue
End Function Private Function zRg12583927(szSection$, szKey$, Value As Variant) As Variant
Dim hkey&, lResult&, lcbValue&, szValue$, lValue&
' Open XL5 registry key, create if it doesn't already exist
lResult& = Z38B15G&(HKEY_CURRENT_USER, SZREGPATH & szSection$, hkeyXL5&)
If lResult& <> ERROR_SUCCESS Then
zRg12583927 = CVErr(xlErrNA)
Exit Function
End If
If TypeName(Value) = "String" Then
lType& = REG_SZ
Value = Value & Chr$(0)
lcbValue& = Len(Value)
lResult& = VC839NBmC&(hkeyXL5&, szKey$, 0&, lType&, CStr(Value), lcbValue&)
' NOTE: REG_DWORD code below doesn't really work
ElseIf TypeName(Value) = "Integer" Or TypeName(Value) = "Long" Then
lType& = REG_DWORD
lcbValue& = 4
lValue& = CLng(Value)
lResult& = B3139Jsx2&(hkeyXL5&, szKey$, 0&, lType&, lValue&, lcbValue&)
Else
Value = CStr(Value)
lType& = REG_SZ
Value = Value & Chr$(0)
lcbValue& = Len(Value)
lResult& = VC839NBmC&(hkeyXL5&, szKey$, 0&, lType&, CStr(Value), lcbValue&)
End If
If lResult& <> ERROR_SUCCESS Then
zRg12583927 = CVErr(xlErrNA)
Exit Function
End If
' Close the XL5 reg key
lResult& = XX348HJKL&(hkeyXL5&)
If lResult& <> ERROR_SUCCESS Then
zRg12583927 = False
Exit Function
End If
End Function Private Function RegGetXLInt(szSection$, szKey$, Optional vDefaultValue) As Integer
Dim vValue As Variant, iValue As Integer
vValue = X39f0392vv(szSection$, szKey$, vDefaultValue)
On Error Resume Next
RegGetXLInt = CInt(vValue)
End Function |