Hallo zusammen,
Vielleicht hat jemand von Euch eine Idee zu folgendem Problem:
Ich habe nachfolgendes Addin laufen. Das hab eich selbstverständlich nicht selbst erstellt! :-)
Es gibt Standardmäsig vor, dass alle 10 Minuten gespeichert wird und erst nachgefragt werden soll, ob gespeichert werden soll. Wenn man Änderungen vornimmt und Excel schliesst dann sind die Änderungen weg. Konkret: Ich möchte, dass standardmässig alle 1 Minuten gespeichert wird, und das ohne nachzufragen.
Weiß jemand wie der Code anzupassen ist?
Vielen Dank im voraus und Viele Grüße
Stefan
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