You are relentless.
Thanks again, Stuart
On Wednesday, August 27, 2014 8:36 PM, "'Graham Mandeno' graham@mandeno.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:
Hi Stuart
I stand humbled and corrected! I don't use Access 2007 but I just discovered it does not have a 64-bit flavour and it still used VBA6, not 7.
You will need to make the following changes to the two functions:
1. Change the #If VBA7 block and its corresponding #Else to include only the Dim hWnd line – LongPtr for VBA7, otherwise Long.
2. Add a test for the Access version being 2007 or later – If SysCmd(acSysCmdAccessVer) >= 12 Then …
All the best,
Graham
I stand humbled and corrected! I don't use Access 2007 but I just discovered it does not have a 64-bit flavour and it still used VBA6, not 7.
You will need to make the following changes to the two functions:
1. Change the #If VBA7 block and its corresponding #Else to include only the Dim hWnd line – LongPtr for VBA7, otherwise Long.
2. Add a test for the Access version being 2007 or later – If SysCmd(acSysCmdAccessVer) >= 12 Then …
All the best,
Graham
================ start code ==================
Public Function GetRibbonHeight() As Long
' Return height of the Ribbon in twips
' Note that the result includes the QAT and the application title bar
#If VBA7 Then
Dim hWnd As LongPtr
#Else
Dim hWnd As Long
#End If
Dim xRect As winRECT
If SysCmd(acSysCmdAccessVer) >= 12 Then
hWnd = FindWindowEx(hWndAccessApp, 0, "MsoCommandBarDock", "MsoDockTop")
If hWnd <> 0 Then
hWnd = FindWindowEx(hWnd, 0, "MsoCommandBar", "Ribbon")
End If
If hWnd = 0 Then
MsgBox "Ribbon not found"
Else
If GetWindowRect(hWnd, xRect) = 0 Then
MsgBox "Cannot determine Ribbon dimensions"
Else
With xRect
GetRibbonHeight = (.Bottom - .Top) * TwipsPerPixelY
End With
End If
End If
Else
' pre-Access2007 - return 0
GetRibbonHeight = 0
End If
End Function
Public Function GetNavPaneWidth() As Long
' Return width of the Nav Pane in twips
#If VBA7 Then
Dim hWnd As LongPtr
#Else
Dim hWnd As Long
#End If
Dim xRect As winRECT
If SysCmd(acSysCmdAccessVer) >= 12 Then
hWnd = FindWindowEx(hWndAccessApp, 0, "NetUINativeHWNDHost", "Navigation Pane Host")
If hWnd = 0 Then
MsgBox "Nav Pane not found"
Else
If GetWindowRect(hWnd, xRect) = 0 Then
MsgBox "Cannot determine Nav Pane dimensions"
Else
With xRect
GetNavPaneWidth = (.Right - .Left) * TwipsPerPixelX
End With
End If
End If
Else
' pre-Access2007 - return 0
GetNavPaneWidth = 0
End If
End Function
================ end code ==================
Public Function GetRibbonHeight() As Long
' Return height of the Ribbon in twips
' Note that the result includes the QAT and the application title bar
#If VBA7 Then
Dim hWnd As LongPtr
#Else
Dim hWnd As Long
#End If
Dim xRect As winRECT
If SysCmd(acSysCmdAccessVer) >= 12 Then
hWnd = FindWindowEx(hWndAccessApp, 0, "MsoCommandBarDock", "MsoDockTop")
If hWnd <> 0 Then
hWnd = FindWindowEx(hWnd, 0, "MsoCommandBar", "Ribbon")
End If
If hWnd = 0 Then
MsgBox "Ribbon not found"
Else
If GetWindowRect(hWnd, xRect) = 0 Then
MsgBox "Cannot determine Ribbon dimensions"
Else
With xRect
GetRibbonHeight = (.Bottom - .Top) * TwipsPerPixelY
End With
End If
End If
Else
' pre-Access2007 - return 0
GetRibbonHeight = 0
End If
End Function
Public Function GetNavPaneWidth() As Long
' Return width of the Nav Pane in twips
#If VBA7 Then
Dim hWnd As LongPtr
#Else
Dim hWnd As Long
#End If
Dim xRect As winRECT
If SysCmd(acSysCmdAccessVer) >= 12 Then
hWnd = FindWindowEx(hWndAccessApp, 0, "NetUINativeHWNDHost", "Navigation Pane Host")
If hWnd = 0 Then
MsgBox "Nav Pane not found"
Else
If GetWindowRect(hWnd, xRect) = 0 Then
MsgBox "Cannot determine Nav Pane dimensions"
Else
With xRect
GetNavPaneWidth = (.Right - .Left) * TwipsPerPixelX
End With
End If
End If
Else
' pre-Access2007 - return 0
GetNavPaneWidth = 0
End If
End Function
================ end code ==================
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Thursday, 28 August 2014 10:22
To: MS_Access_Professionals@yahoogroups.com
Subject: RE: [MS_AccessPros] widths and heights
Sent: Thursday, 28 August 2014 10:22
To: MS_Access_Professionals@yahoogroups.com
Subject: RE: [MS_AccessPros] widths and heights
Hi Stuart
I suggested setting the breakpoint on the actual "Public Function" line. That is outside the conditional blocks, so you can see which block is being used. Do the same for GetNavPaneWidth. It doesn't make sense that GetNavPaneWidth is using the VBA7 block, but GetRibbonHeight is not.
Graham
I suggested setting the breakpoint on the actual "Public Function" line. That is outside the conditional blocks, so you can see which block is being used. Do the same for GetNavPaneWidth. It doesn't make sense that GetNavPaneWidth is using the VBA7 block, but GetRibbonHeight is not.
Graham
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Thursday, 28 August 2014 10:15
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights
Sent: Thursday, 28 August 2014 10:15
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights
I am using Access 2007. I can't set breakpoints inside the "hash tagged" code, but I think I know what is going on. The "If VBA7" code in the declarations is showing in red, the Else code is normal, so I am assuming that Access 2007 is pre-VBA7, yet it has a ribbon. I tried changing VBA7 to VBA6 and got compile errors. Any other ideas?
Stuart
On Wednesday, August 27, 2014 5:21 PM, "'Graham Mandeno' graham@mandeno.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:
Hi Stuart
That's odd. What version of Access? For me (A2010/64 or A2013/32) GetRibbonHeight returns 2595, or 1305 if the ribbon is collapsed.
Can you set a breakpoint on the line "Public Function GetRibbonHeight() As Long" and step through the code to see what path it is taking? Specifically, check that hWnd is never assigned a value of zero, and that TwipsPerPixelY is not returning zero (it should be 15 or thereabouts).
Cheers,
Graham
That's odd. What version of Access? For me (A2010/64 or A2013/32) GetRibbonHeight returns 2595, or 1305 if the ribbon is collapsed.
Can you set a breakpoint on the line "Public Function GetRibbonHeight() As Long" and step through the code to see what path it is taking? Specifically, check that hWnd is never assigned a value of zero, and that TwipsPerPixelY is not returning zero (it should be 15 or thereabouts).
Cheers,
Graham
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Thursday, 28 August 2014 05:21
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights
Sent: Thursday, 28 August 2014 05:21
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights
Graham, this version is returning 0 for ribbon. navpane looks good.....
Stuart
On Wednesday, August 27, 2014 8:15 AM, "Crystal strive4peace2008@yahoo.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:
Hi Graham, right away, I see this:
#If VBA7 Then
' use LongPtr
#Else
'As Long
#End if
what are other changes that you make?
thanks!
#If VBA7 Then
' use LongPtr
#Else
'As Long
#End if
what are other changes that you make?
thanks!
Warm Regards,
Crystal
Contacts database in Access
Contacts_070604 ... being updated ~ hopefully post something new in a few months
 | |||||||
SPAM-FREE advice and knowledge pool for beginners through advanced users of Microsoft Access and databases in general. Please Note: New Members will have thei... | |||||||
Preview by Yahoo | |||||||
*
(: have an awesome day :)
*
On Wednesday, August 27, 2014 5:58 AM, "Crystal strive4peace2008@yahoo.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:
thanks for explaining, Graham ~ this is a great example for using conditional compilation for 32 and 64-bit
Warm Regards,
Crystal
Graph with Access!
How to create a chart:and how to change it with VBA
*
(: have an awesome day :)
*
On Tuesday, August 26, 2014 9:26 PM, "'Graham Mandeno' graham@mandeno.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:
Hi Crystal
That's because most of it is API declarations, and each of them requires two forms – one for VBA7 and one for earlier versions.
Strictly speaking, the pre-VBA7 forms are not required in this case, because there would be neither a ribbon nor a nav pane, but it's good practice to declare them properly :-)
Cheers, G.
That's because most of it is API declarations, and each of them requires two forms – one for VBA7 and one for earlier versions.
Strictly speaking, the pre-VBA7 forms are not required in this case, because there would be neither a ribbon nor a nav pane, but it's good practice to declare them properly :-)
Cheers, G.
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Wednesday, 27 August 2014 14:03
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights
Sent: Wednesday, 27 August 2014 14:03
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights
thanks, Graham. The code lines seem to have about doubled ... I've saved this and am sure I will be studying it sometime down the road ...
Warm Regards,
Crystal
Crystal
Code Documenter for Access -- New Reports!
http://www.accessmvp.com/strive4peace/CodeDocumenter.htm#Download
http://www.accessmvp.com/strive4peace/CodeDocumenter.htm#Download
 | |||||||
The Code Documenter analyzes ACCDB and MDB files. Watch for updates. Access 2007+ version Crystals_CodeDocumenter_120204_2p_BETA_ACCDE_TXT.zip | |||||||
Preview by Yahoo | |||||||
Through sharing, we will all get better
~ have an awesome day ~
On Tuesday, August 26, 2014 6:44 PM, "'Graham Mandeno' graham@mandeno.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:
Hi Stuart and Crystal (and anyone else who's interested),
Here is an all-version-friendly update. I've tested it on A2003, A2010-64, and A2013-32. (Of course, both functions return zero on A2003 because it has neither ribbon nor nav pane).
Cheers,
Graham
Here is an all-version-friendly update. I've tested it on A2003, A2010-64, and A2013-32. (Of course, both functions return zero on A2003 because it has neither ribbon nor nav pane).
Cheers,
Graham
=============== start code ================
Option Compare Database
Option Explicit
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const nTwipsPerInch As Long = 1440
Private dTwipsPerPixelX As Double
Private dTwipsPerPixelY As Double
Private Type winRECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
#If VBA7 Then
Private Declare PtrSafe Function GetDC _
Lib "user32" ( _
ByVal hWnd As LongPtr _
) As LongPtr
#Else
Private Declare Function GetDC _
Lib "user32" ( _
ByVal hWnd As Long _
) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function ReleaseDC _
Lib "user32" ( _
ByVal hWnd As LongPtr _
, ByVal hdc As LongPtr _
) As Long
#Else
Private Declare Function ReleaseDC _
Lib "user32" ( _
ByVal hWnd As Long _
, ByVal hdc As Long _
) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetDeviceCaps _
Lib "gdi32" ( _
ByVal hdc As LongPtr _
, ByVal nIndex As Long _
) As Long
#Else
Private Declare Function GetDeviceCaps _
Lib "gdi32" ( _
ByVal hdc As Long _
, ByVal nIndex As Long _
) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetWindowRect _
Lib "user32" ( _
ByVal hWnd As LongPtr _
, lpRect As winRECT _
) As Long
#Else
Private Declare Function GetWindowRect _
Lib "user32" ( _
ByVal hWnd As Long _
, lpRect As winRECT _
) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function FindWindowEx _
Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWndParent As LongPtr _
, ByVal hwndChildAfter As LongPtr _
, ByVal lpszClass As String _
, ByVal lpszWindow As String _
) As LongPtr
#Else
Private Declare Function FindWindowEx _
Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWndParent As Long _
, ByVal hwndChildAfter As Long _
, ByVal lpszClass As String _
, ByVal lpszWindow As String _
) As Long
#End If
Private Function TwipsPerPixelX() As Double
If dTwipsPerPixelX = 0 Then GetScreenMetrics
TwipsPerPixelX = dTwipsPerPixelX
End Function
Private Function TwipsPerPixelY() As Double
If dTwipsPerPixelY = 0 Then GetScreenMetrics
TwipsPerPixelY = dTwipsPerPixelY
End Function
Private Sub GetScreenMetrics()
#If VBA7 Then
Dim hdc As LongPtr
#Else
Dim hdc As Long
#End If
hdc = GetDC(0)
dTwipsPerPixelX = nTwipsPerInch / GetDeviceCaps(hdc, LOGPIXELSX)
dTwipsPerPixelY = nTwipsPerInch / GetDeviceCaps(hdc, LOGPIXELSY)
Call ReleaseDC(0, hdc)
End Sub
Public Function GetRibbonHeight() As Long
' Return height of the Ribbon in twips
' Note that the result includes the QAT and the application title bar
#If VBA7 Then
Dim hWnd As LongPtr
Dim xRect As winRECT
hWnd = FindWindowEx(hWndAccessApp, 0, "MsoCommandBarDock", "MsoDockTop")
If hWnd <> 0 Then
hWnd = FindWindowEx(hWnd, 0, "MsoCommandBar", "Ribbon")
End If
If hWnd = 0 Then
MsgBox "Ribbon not found"
Else
If GetWindowRect(hWnd, xRect) = 0 Then
MsgBox "Cannot determine Ribbon dimensions"
Else
With xRect
GetRibbonHeight = (.Bottom - .Top) * TwipsPerPixelY
End With
End If
End If
#Else
' pre-Access2007 - return 0
GetRibbonHeight = 0
#End If
End Function
Public Function GetNavPaneWidth() As Long
' Return width of the Nav Pane in twips
#If VBA7 Then
Dim hWnd As LongPtr
Dim xRect As winRECT
hWnd = FindWindowEx(hWndAccessApp, 0, "NetUINativeHWNDHost", "Navigation Pane Host")
If hWnd = 0 Then
MsgBox "Nav Pane not found"
Else
If GetWindowRect(hWnd, xRect) = 0 Then
MsgBox "Cannot determine Nav Pane dimensions"
Else
With xRect
GetNavPaneWidth = (.Right - .Left) * TwipsPerPixelX
End With
End If
End If
#Else
' pre-Access2007 - return 0
GetNavPaneWidth = 0
#End If
End Function
===================== end code =================================
Option Compare Database
Option Explicit
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const nTwipsPerInch As Long = 1440
Private dTwipsPerPixelX As Double
Private dTwipsPerPixelY As Double
Private Type winRECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
#If VBA7 Then
Private Declare PtrSafe Function GetDC _
Lib "user32" ( _
ByVal hWnd As LongPtr _
) As LongPtr
#Else
Private Declare Function GetDC _
Lib "user32" ( _
ByVal hWnd As Long _
) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function ReleaseDC _
Lib "user32" ( _
ByVal hWnd As LongPtr _
, ByVal hdc As LongPtr _
) As Long
#Else
Private Declare Function ReleaseDC _
Lib "user32" ( _
ByVal hWnd As Long _
, ByVal hdc As Long _
) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetDeviceCaps _
Lib "gdi32" ( _
ByVal hdc As LongPtr _
, ByVal nIndex As Long _
) As Long
#Else
Private Declare Function GetDeviceCaps _
Lib "gdi32" ( _
ByVal hdc As Long _
, ByVal nIndex As Long _
) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetWindowRect _
Lib "user32" ( _
ByVal hWnd As LongPtr _
, lpRect As winRECT _
) As Long
#Else
Private Declare Function GetWindowRect _
Lib "user32" ( _
ByVal hWnd As Long _
, lpRect As winRECT _
) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function FindWindowEx _
Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWndParent As LongPtr _
, ByVal hwndChildAfter As LongPtr _
, ByVal lpszClass As String _
, ByVal lpszWindow As String _
) As LongPtr
#Else
Private Declare Function FindWindowEx _
Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWndParent As Long _
, ByVal hwndChildAfter As Long _
, ByVal lpszClass As String _
, ByVal lpszWindow As String _
) As Long
#End If
Private Function TwipsPerPixelX() As Double
If dTwipsPerPixelX = 0 Then GetScreenMetrics
TwipsPerPixelX = dTwipsPerPixelX
End Function
Private Function TwipsPerPixelY() As Double
If dTwipsPerPixelY = 0 Then GetScreenMetrics
TwipsPerPixelY = dTwipsPerPixelY
End Function
Private Sub GetScreenMetrics()
#If VBA7 Then
Dim hdc As LongPtr
#Else
Dim hdc As Long
#End If
hdc = GetDC(0)
dTwipsPerPixelX = nTwipsPerInch / GetDeviceCaps(hdc, LOGPIXELSX)
dTwipsPerPixelY = nTwipsPerInch / GetDeviceCaps(hdc, LOGPIXELSY)
Call ReleaseDC(0, hdc)
End Sub
Public Function GetRibbonHeight() As Long
' Return height of the Ribbon in twips
' Note that the result includes the QAT and the application title bar
#If VBA7 Then
Dim hWnd As LongPtr
Dim xRect As winRECT
hWnd = FindWindowEx(hWndAccessApp, 0, "MsoCommandBarDock", "MsoDockTop")
If hWnd <> 0 Then
hWnd = FindWindowEx(hWnd, 0, "MsoCommandBar", "Ribbon")
End If
If hWnd = 0 Then
MsgBox "Ribbon not found"
Else
If GetWindowRect(hWnd, xRect) = 0 Then
MsgBox "Cannot determine Ribbon dimensions"
Else
With xRect
GetRibbonHeight = (.Bottom - .Top) * TwipsPerPixelY
End With
End If
End If
#Else
' pre-Access2007 - return 0
GetRibbonHeight = 0
#End If
End Function
Public Function GetNavPaneWidth() As Long
' Return width of the Nav Pane in twips
#If VBA7 Then
Dim hWnd As LongPtr
Dim xRect As winRECT
hWnd = FindWindowEx(hWndAccessApp, 0, "NetUINativeHWNDHost", "Navigation Pane Host")
If hWnd = 0 Then
MsgBox "Nav Pane not found"
Else
If GetWindowRect(hWnd, xRect) = 0 Then
MsgBox "Cannot determine Nav Pane dimensions"
Else
With xRect
GetNavPaneWidth = (.Right - .Left) * TwipsPerPixelX
End With
End If
End If
#Else
' pre-Access2007 - return 0
GetNavPaneWidth = 0
#End If
End Function
===================== end code =================================
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Wednesday, 27 August 2014 08:04
To: MS_Access_Professionals@yahoogroups.com
Subject: RE: [MS_AccessPros] widths and heights
Sent: Wednesday, 27 August 2014 08:04
To: MS_Access_Professionals@yahoogroups.com
Subject: RE: [MS_AccessPros] widths and heights
So glad you finally got it :-)
It's easy enough to change the API Declares to be 64-bit compatible. I'll do that and post later. Keep an eye on that spam folder :-)
Cheers,
Graham
It's easy enough to change the API Declares to be 64-bit compatible. I'll do that and post later. Keep an eye on that spam folder :-)
Cheers,
Graham
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Wednesday, 27 August 2014 07:28
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights
Sent: Wednesday, 27 August 2014 07:28
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights
It works, it works perfectly!
But I just had a bad thought. A couple of the users are using 64 bit office, and I think you are using the 32 bit stuff.....
__._,_.___
Posted by: Stuart Schulman <stoughy@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (41) |
.
__,_._,___
Tidak ada komentar:
Posting Komentar