Hallo Allerseits
Versuche seit langem dieses Code zum laufen zum bringen.
Vorher:
Windows7 64bit , Office/Access 2010 32bit.
Aktuell: Windows8 64bit , Office/Access 2013 64bit.
Die datenbank lauft nicht respektiv macht mein formular nicht auf automatisch unter Access 2013,
Declare funktion stimme nicht un muss aktualisiert werden.
Ich versuche verzweifelt irgendwas zu ändern aber funktionert nicht.
Daswegen bin ich um jeden tipp dankbar.
gruss
FM
CODE:
Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(LpVersionInformation As OSVERSIONINFO) As Long
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As _
MEMORYSTATUS)
Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As _
SYSTEM_INFO)
'------------------------------------------------------------------------
'
' MODULE
'
'
Windows API Utilities
'
' PURPOSE
'
' Provides routines for manipulating Microsoft Access forms and
' windows through the Window API.
'
' NOTES
'
' Most of the symbols in this module are prefixed with 'WU_',
' in an attempt to avoid naming conflicts with library databases.
'
'------------------------------------------------------------------------
Option Compare Text ' Non case sensitive compares
'
' Type WU_RECT.
'
Type WU_RECT
x1 As Integer
y1 As Integer
x2 As Integer
y2 As Integer
End Type
'
' Windows API Declarations.
'
'*** 32-Bit declaration
'
Declare Function wu_SetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Declare Function wu_IsZoomed Lib "user32" Alias "IsZoomed" (ByVal hwnd As Long) As Long
Declare Function wu_GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Long
Declare Function wu_GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function wu_GetParent Lib "user32" Alias "GetParent" (ByVal hwnd As Long) As Long
Declare Function wu_GetMenu Lib "user32" Alias "GetMenu" (ByVal hwnd As Long) As Long
Declare Function wu_GetSubMenu Lib "user32" Alias "GetSubMenu" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function wu_DrawMenuBar Lib "user32" Alias "DrawMenuBar" (ByVal hwnd As Long) As Long
Declare Function wu_CheckMenuItem Lib "user32" Alias "CheckMenuItem" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
'------------------------------------------------------------------------
' FUNCTION : wu_StWindowClass
'
' PURPOSE : A simple cover function to the Windows API call.
'------------------------------------------------------------------------
Function wu_StWindowClass(hwnd As Long) As String
Const cchMax = 255
Dim stBuff As String * cchMax, cch As Long
cch = wu_GetClassName(hwnd, stBuff, cchMax)
If (hwnd = 0) Then
wu_StWindowClass = ""
Else
wu_StWindowClass = (Left$(stBuff, cch))
End If
End Function
'------------------------------------------------------------------------
' FUNCTION : wu_GetAccessHwnd()
'
' PURPOSE : Returns a handle the the Access window.
'------------------------------------------------------------------------
Function wu_GetAccessHwnd() As Long
Dim hwnd As Long
hwnd = wu_GetActiveWindow()
While ((wu_StWindowClass(hwnd) <> WU_WC_ACCESS) And (hwnd <> 0))
hwnd = wu_GetParent(hwnd)
Wend
wu_GetAccessHwnd = hwnd
End Function
'------------------------------------------------------------------------
' FUNCTION : wu_SetMenuChecked
'
' PURPOSE : Sets the checkmark next to a menu item on or off.
'
' ARGUMENTS : iMenu% - The index of the drop down menu
' iItem% - The index of the item on the menu
' Both of these arguments are zero based.
' fChecked% - True to show the checkmark, false otherwise.
'------------------------------------------------------------------------
Function wu_SetMenuChecked(iMenu As Long, iItem As Long, fChecked As Long, hwnd As Variant) As Long
Dim hMainMenu As Long, hMenu As Long, fuFlags As Long, F As Long
If IsNull(hwnd) Then
hwnd = Screen.ActiveForm.hwnd
End If
If (wu_IsZoomed(hwnd)) Then
iMenu = iMenu + 1
End If
hMainMenu = wu_GetMenu(wu_GetAccessHwnd())
hMenu = wu_GetSubMenu(hMainMenu, iMenu)
If (fChecked) Then
fuFlags = WU_MF_BYPOSITION Or WU_MF_CHECKED
Else
fuFlags = WU_MF_BYPOSITION Or WU_MF_UNCHECKED
End If
F = wu_CheckMenuItem(hMenu, iItem, fuFlags)
wu_DrawMenuBar (wu_GetAccessHwnd())
wu_SetMenuChecked = F
End Function
