UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
> Code Not Working In One Db Out Of Three, Access 2016    
 
   
tina t
post Oct 5 2019, 08:09 PM
Post#1



Posts: 6,175
Joined: 11-November 10
From: SoCal, USA


hi folks, back again. i have some code that I've been running for a good ten years at least, in A97, in four different FE dbs. i converted three of the dbs to A2016, and this particular code ran without issue. i dumped all the objects from those three dbs into three new created-in-A2016-64bit dbs (due to another issue), and this bit of code continued to run without issue.

now I've converted my last FE db from A97 to A2016 today, and this same bit of code keeps erring out. i created a new A2016 db and dumped all the objects into it; the code continues to err out. my VBA references are identical to one of the other dbs that decompiles/recompiles/compacts and runs without flaw.

i don't get it. anybody got any ideas?

tia
tina

btw, i didn't write the code. i got it from...well, somewhere online or from a book, I'm sure, but neglected to document the source in my code at the time.

Class module:

CODE
Option Compare Database
Option Explicit



#If VBA7 And Win64 Then
'Private Declare PtrSafe Function
#Else
#End If



#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
   ByVal bRevert As Long) As Long
#Else
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, _
   ByVal bRevert As Long) As Long
#End If

#If VBA7 And Win64 Then
Private Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As _
   Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#Else
Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
   Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#End If

#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetMenuItemInfo Lib "user32" Alias _
   "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As _
   Long, lpMenuItemInfo As MENUITEMINFO) As Long
#Else
Private Declare Function GetMenuItemInfo Lib "user32" Alias _
   "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As _
   Long, lpMenuItemInfo As MENUITEMINFO) As Long
#End If

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type

Const MF_GRAYED = &H1&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060&

Public Property Get Enabled() As Boolean
    Dim hWnd As Long
    Dim hMenu As Long
    Dim Result As Long
    Dim MI As MENUITEMINFO
    
    MI.cbSize = Len(MI)
    MI.dwTypeData = String(80, 0)
    MI.cch = Len(MI.dwTypeData)
    MI.fMask = MF_GRAYED
    MI.wID = SC_CLOSE
    hWnd = Application.hWndAccessApp
    hMenu = GetSystemMenu(hWnd, 0)
    Result = GetMenuItemInfo(hMenu, MI.wID, 0, MI)
    Enabled = (MI.fState And MF_GRAYED) = 0
End Property

Public Property Let Enabled(boolClose As Boolean)
    Dim hWnd As Long
    Dim wFlags As Long
    Dim hMenu As Long
    Dim Result As Long
    
    hWnd = Application.hWndAccessApp
    hMenu = GetSystemMenu(hWnd, 0)
    If Not boolClose Then
        wFlags = MF_BYCOMMAND Or MF_GRAYED
    Else
        wFlags = MF_BYCOMMAND And Not MF_GRAYED
    End If
    Result = EnableMenuItem(hMenu, SC_CLOSE, wFlags)
End Property

Standard module:
CODE
Public Function isResetXButton(ByVal bln As Boolean)

    Dim C As XButton
    Set C = New XButton
    
    C.Enabled = bln

End Function

when i try to compile the project, i get an error on the last line:

C.Enabled = bln

Attached File  Capture.PNG ( 10.56K )Number of downloads: 5

--------------------
"the wheel never stops turning"
Go to the top of the page
 

Posts in this topic



Custom Search


RSSSearch   Top   Lo-Fi    6th December 2019 - 07:35 AM