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
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
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!
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.
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
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
Code Documenter for Access -- New Reports!
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
=============== 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 =================================
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
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
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
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: "Graham Mandeno" <graham@mandeno.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (37) |
Tidak ada komentar:
Posting Komentar