Access Forms Have No Top Property?

[mattdrinks]

Working in Access 2000 and Excel 2000

I have a button on an access form which runs the following code:

Private Sub cmdGetData_Click()

Dim xlData As Excel.Application
Dim strFileName As String
Dim bar As Office.CommandBar
Dim intI As Integer

Dim lngFormWidth As Long
Dim lngFormHeight As Long

Dim booBarEnabled() As Boolean
Dim booDisplayFormulaBar As Boolean
Dim intTotalCommandBars As Integer


'open an instance of excel
Set xlData = CreateObject("Excel.Application")

'count the visible commandbars in excel
intTotalCommandBars = 0
For Each bar In xlData.CommandBars
    intTotalCommandBars = intTotalCommandBars + 1
Next

'redeclare the array at the correct size
ReDim booBarEnabled(intTotalCommandBars) As Boolean

'save current status then disable all command bars
intI = 0
For Each bar In xlData.CommandBars
    booBarEnabled(intI) = bar.Enabled
    bar.Enabled = False
    intI = intI + 1
Next

'save current excel settings
booDisplayFormulaBar = xlData.DisplayFormulaBar

'set up excel with options we reqiuire
xlData.DisplayFormulaBar = False

'let user select a file
strFileName = xlData.GetOpenFilename("CSV, *.csv, Excel, *.xls")
xlData.Workbooks.Open (strFileName)

'set the excel window size
xlData.WindowState = xlNormal

lngFormHeight = Me.WindowHeight / 20
lngFormWidth = Me.WindowWidth / 20

xlData.Width = lngFormWidth
xlData.Height = lngFormHeight / 2

'make excel visible
xlData.Visible = True
MsgBox (strFileName)

'set excel back to original settings
intI = 0
For Each bar In xlData.CommandBars
    bar.Enabled = booBarEnabled(intI)
    intI = intI + 1
Next
xlData.DisplayFormulaBar = booDisplayFormulaBar

xlData.Quit
Set xlData = Nothing

End Sub

This all works fine but I would like to show the instance of excel in the lower part of the form, I can set the excel window to the right size and can keep it in proportion using code in the resize event of the form.

But I can not find a property of the form that tells me where the form is postioned on the screen allowing me to postion the instance of excel in the correct place whenever the form is moved.

The application object of excel has a top property it contains: The distance from the top edge of the screen to the top edge of the main Microsoft Excel window.
I can not find a similar property for an access form allowing me to synchronize them.

Can anybody point me in the right direction, any help greatly appricaited.

Matt

 

[VBslammer]

You're going to have to use the API. This might need some tweaking but should give you a start. Get a form's top using:

lngTop = FormTop(Forms("MyForm&quot.Hwnd)

-----------------------------------------------------------

Public Declare Function GetParent Lib "user32" (ByVal Hwnd As Long) As Long

Public Declare Function GetWindowRect Lib "user32" _
(ByVal Hwnd As Long, lpRect As RECT) As Long

Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long

Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

Public Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, _
ByVal hdc As Long) As Long

Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
Public Const mTwipsPerInch = 1440

Public Type POINTAPI
X As Long
Y As Long
End Type

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public Type COORDS
Left As Long
Top As Long
Width As Long
Height As Long
End Type

Private mTwipsPerPixel As POINTAPI

Public Function FormTop(ByRef Hwnd As Long) As Long
On Error GoTo ErrHandler

Dim cds As COORDS
Call GetCoords(Hwnd, cds)
FormTop = cds.Top

ExitHere:
Exit Function
ErrHandler:
Debug.Print "Error: " & Err & " - " & Err.Description
Resume ExitHere
End Function

Private Sub GetCoords(ByRef Hwnd As Long, ByRef cds As COORDS)
On Error GoTo ErrHandler

Dim hWndParent As Long
Dim rctParent As RECT
Dim rct As RECT

hWndParent = GetParent(Hwnd)

Call GetWindowRect(Hwnd, rct)
Call GetWindowRect(hWndParent, rctParent)
Call GetScreenInfo

With rct
.Left = .Left - rctParent.Left
.Top = .Top - rctParent.Top
.Right = .Right - rctParent.Left
.Bottom = .Bottom - rctParent.Top
End With

With cds
.Left = rct.Left * mTwipsPerPixel.X
.Top = rct.Top * mTwipsPerPixel.Y
.Height = rct.Bottom - rct.Top
.Width = rct.Right - rct.Left
End With

ExitHere:
Exit Sub
ErrHandler:
Debug.Print "Error: " & Err & " - " & Err.Description
Resume ExitHere
End Sub

Private Sub GetScreenInfo()
On Error GoTo ErrHandler

Dim lngDC As Long
Dim ptCurrentDPI As POINTAPI
Const HWND_DESKTOP = 0

lngDC = GetDC(HWND_DESKTOP)

If lngDC <> 0 Then
' Get the pixels/inch ratio.
ptCurrentDPI.X = GetDeviceCaps(lngDC, LOGPIXELSX)
ptCurrentDPI.Y = GetDeviceCaps(lngDC, LOGPIXELSY)

mTwipsPerPixel.X = mTwipsPerInch / ptCurrentDPI.X
mTwipsPerPixel.Y = mTwipsPerInch / ptCurrentDPI.Y

Call ReleaseDC(HWND_DESKTOP, lngDC)
End If

ExitHere:
Exit Sub
ErrHandler:
Debug.Print &quot;Error: &quot; & Err & &quot; - &quot; & Err.Description
Resume ExitHere
End Sub VBSlammer

 

[mattdrinks]

Excellent code I have never used the API before but using your code and an article I found at the Microsoft Knowledge base I have managed to achieve what I wanted. The knowledge base article is Q210141 and is at:

http://support.microsoft.com/default.aspx?scid=kb;en-us;Q210141

Just in case anyone else might need it.

thanks for your help VBslammer

Matt