473,715 Members | 2,860 Online
Bytes | Software Development & Data Engineering Community
+ Post

Home Posts Topics Members FAQ

Access Relationships Window: Proper Layout?

Hi, I am using access 2003, I would like to know if there is an option
to reorganize the tables in a maner that is readable, as we can do in
sql sever 2000 or 2005.

I have been given a database to look a and I am loosing tremendious
amounts of time trying to organize it so that I could view it.

Regards,
Alexandre Brisebois

Jun 19 '06 #1
4 6405
On 19 Jun 2006 06:21:41 -0700, al************* ****@gmail.com wrote:

No.
It may make sense to upsize your db to SQL Server (Tools > Database
utilities > Upsizing wizard) just for this feature.

-Tom.

Hi, I am using access 2003, I would like to know if there is an option
to reorganize the tables in a maner that is readable, as we can do in
sql sever 2000 or 2005.

I have been given a database to look a and I am loosing tremendious
amounts of time trying to organize it so that I could view it.

Regards,
Alexandre Brisebois


Jun 20 '06 #2
I've got a tool that will automatically reorganize and add field/table info
to the Relationship window. I have been trying to find the time to publish
it in the last month without success. I start my vacation in July and will
definately have time then.

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.
"Tom van Stiphout" <no************ *@cox.net> wrote in message
news:4b******** *************** *********@4ax.c om...
On 19 Jun 2006 06:21:41 -0700, al************* ****@gmail.com wrote:

No.
It may make sense to upsize your db to SQL Server (Tools > Database
utilities > Upsizing wizard) just for this feature.

-Tom.

Hi, I am using access 2003, I would like to know if there is an option
to reorganize the tables in a maner that is readable, as we can do in
sql sever 2000 or 2005.

I have been given a database to look a and I am loosing tremendious
amounts of time trying to organize it so that I could view it.

Regards,
Alexandre Brisebois

Jun 21 '06 #3
On Wed, 21 Jun 2006 01:18:20 GMT, "Stephen Lebans"
<ForEmailGotoMy .WebSite.-WWWdotlebansdot ...@linvalid.co m> wrote:

Very cool. I have often thought what it would take to write such a
routine. Still pretty clueless. Perhaps you'll write an article for
some magazine?

Can we have multiple views as well?

-Tom.

I've got a tool that will automatically reorganize and add field/table info
to the Relationship window. I have been trying to find the time to publish
it in the last month without success. I start my vacation in July and will
definately have time then.


Jun 25 '06 #4
"Tom van Stiphout" <no************ *@cox.net> wrote in message
news:an******** *************** *********@4ax.c om...
On Wed, 21 Jun 2006 01:18:20 GMT, "Stephen Lebans"
<ForEmailGotoMy .WebSite.-WWWdotlebansdot ...@linvalid.co m> wrote:

Very cool. I have often thought what it would take to write such a
routine. Still pretty clueless. Perhaps you'll write an article for
some magazine?

Can we have multiple views as well?

-Tom.

I've got a tool that will automatically reorganize and add field/table
info
to the Relationship window. I have been trying to find the time to publish
it in the last month without success. I start my vacation in July and will
definately have time then.


Hi Tom
I already have a solution on my site to support mutliple Relationship views.
I'll have to see about integrating into this RelationShip view to PDF doc
solution.

I found it very difficult to develop the logic to automatically resize and
reposition the existing relationship windows. I'm not 100% satisfied with my
current solution but it does work quite well. I have tested it against
RelationShip views with hundreds of tables.

I've posted the main function's code below. Please remember this is very
raw. I have yet to clean the code, structure the comments properly, and
optimize the logic. But it does work as it stands now.
--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.


Public Function RelationsToPDF( ctl As Access.Control) As Boolean
' The Font characteristics of the control passed to this function
' are used for the created PDF document.

Dim rlBlob() As RelWindow
' Copy of RelWindow but with minimal info and no fixed length strings
Dim rl() As RelWindowMin
Dim rlTemp() As RelWindowMin

' The RelationShip window BLOB from the System table
Dim rb As RelBlob

Dim db As DAO.Database 'This database.
Dim tdf As DAO.TableDef 'Each table referenced in the Relationships
window.
Dim tdfForeign As DAO.TableDef

Dim SRelTableName As String
Dim SRelFieldName As String
Dim sCodes As String

Dim s As String, sTable As String, sForeign As String
Dim blRet As Boolean
Dim lRet As Long
Dim lTemp As Long

' Current Screen Resolution
Dim Xdpi As Double
Dim Ydpi As Double
Dim lngIC As Long
Dim ConvX As Double
Dim ConvY As Double

Dim X1 As Long, X2 As Long, Y1 As Long, Y2 As Long
Dim X2Max As Long, Y2Max As Long
Dim X1Prev As Long, Y1Prev As Long
X2Max = 0
Y2Max = 0
Dim ctr As Long

' Current Column window width
Dim Width As Long
' Vars to create Font and Measure Text Width and Height
' Structure for DrawText calc
Dim sRect As RECT

' Reports Device Context
Dim hDC As Long

Dim newfont As Long
' Handle to our Font Object we created.
' We must destroy it before exiting main function

Dim oldfont As Long
' Device COntext's Font we must Select back into the DC
' before we exit this function.

' Logfont struct
Dim myfont As LOGFONT

' TextMetric struct
Dim tm As TEXTMETRIC

' LineSpacing Amount
Dim lngLineSpacing As Long

' Ttemp var
Dim numLines As Long

' Temp string var for current printer name
Dim strName As String

' Temp vars
Dim sngTemp1 As Single
Dim sngTemp2 As Single

Dim sText As String
' RelationShip OrdinalPosition Primary table->Field
Dim ReOPp As Integer
' RelationShip OrdinalPosition Foreign table->Field
Dim ReOPf As Integer
Dim fld As DAO.Field

' inner loop counter
Dim i As Integer

Dim rel As Relation
' Let's see if the DynaPDF.DLL is available.
blRet = LoadLib()
If blRet = False Then
' Cannot find DynaPDF.dll or StrStorage.dll file
Exit Function
End If

On Error GoTo ERR_RelationsTo PDF
'Initialize: Open the Relationships report in design view.
Set db = CurrentDb()

sCodes = ""
' Field Types:
' ===========
' A AutoNumber field (size Long Integer)
' B Byte (Number)
' C Currency
' Dbl Double (Number)
' Dec Decimal (Number)
' Dt Date/Time
' Guid Replication ID (Globally Unique IDentifier)
' Hyp Hyperlink
' Int Integer (Number)
' L Long Integer (Number)
' M Memo field
' Ole OLE Object
' Sng Single (Number)
' T Text, with number of characters (size)
' Yn Yes/No
' ? Unknown field type

' Indexes:
' =======
' P Primary Key
' U Unique Index ('No Duplicates')
' I Indexed ('Duplicates Ok')
' Note: Lower case p, u, or i indicates a secondary field in a multi-field
index.

' Properties:
' ==========
' D Default Value set.
' R Required property is Yes
' V Validation Rule set.
' Z Allow Zero-Length is Yes (Text, Memo and Hyperlink only.)


' Get current Screen DPI
lngIC = apiCreateIC("DI SPLAY", vbNullString, vbNullString, vbNullString)
'If the call to CreateIC didn't fail, then get the Screen X resolution.
If lngIC <> 0 Then
Xdpi = apiGetDeviceCap s(lngIC, LOGPIXELSX)
Ydpi = apiGetDeviceCap s(lngIC, LOGPIXELSY)
'Release the information context.
apiDeleteDC (lngIC)
Else
' Something has gone wrong. Assume an average value.
Xdpi = 120
Ydpi = 120
End If
' Create a temp Device Context
' Create our Font and select into the DC
' Get handle to screen Device Context
hDC = apiGetDC(0&)

With ctl
myfont.lfClipPr ecision = CLIP_LH_ANGLES
myfont.lfOutPre cision = OUT_TT_ONLY_PRE CIS
myfont.lfEscape ment = 0
myfont.lfFaceNa me = .FontName & Chr$(0)
myfont.lfWeight = .FontWeight
myfont.lfItalic = .FontItalic
myfont.lfUnderl ine = .FontUnderline
'Must be a negative figure for height or system will return
'closest match on character cell not glyph
myfont.lfHeight = (.FontSize / 72) * -Ydpi
' Create our temp font
newfont = apiCreateFontIn direct(myfont)
End With

If newfont = 0 Then
Err.Raise vbObjectError + 256, "fTextWidthOrHe ight", "Cannot Create
Font"
End If

' Select the new font into our DC.
oldfont = apiSelectObject (hDC, newfont)

' Get TextMetrics. This is required to determine
' Text height and the amount of extra spacing between lines.
lRet = GetTextMetrics( hDC, tm)

' Our DC is now ready for our calls to:
' Calculate our bounding box based on the controls current width
' lngRet = apiDrawText(hDC , sText, -1, sRect, DT_CALCRECT Or DT_TOP Or _
' DT_LEFT Or DT_WORDBREAK Or DT_EXTERNALLEAD ING Or DT_EDITCONTROL Or
DT_NOCLIP)
' Decode the RelationShip window BLOB
GetBlob rb, rlBlob
' Copy of array of RelWindow structures over to our minimal RelWindow struct
' so we can get rid of unused junk and the fixed length Unicode strings.
ReDim Preserve rl(0 To UBound(rlBlob))

For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
' rb.ScrollBarXof fset + rb.ScrollBarYof fset will always be either:
' 0 - Both Vertical and Horiz ScrollBars are at the Home(0,0)
position
' a value signifying the offset of the pertinent ScrollBar to be
added
' to the negative X1,Y1,X2,Y2 coordinates.
' We can safely add
.RelWinX1 = (rlBlob(ctr).Re lWinX1) + rb.ScrollBarXof fset
.RelWinX2 = (rlBlob(ctr).Re lWinX2) + rb.ScrollBarXof fset
.RelWinY1 = (rlBlob(ctr).Re lWinY1) + rb.ScrollBarYof fset
.RelWinY2 = (rlBlob(ctr).Re lWinY2) + rb.ScrollBarYof fset

' ' Add a user defined Left Margin
' Dim LeftMargin As Long
' LeftMargin = 20
' .RelWinX1 = .RelWinX1 + LeftMargin
' .RelWinX2 = .RelWinX2 + LeftMargin

s = StrConv(rlBlob( ctr).WinName, vbFromUnicode)
s = Left$(s, InStr(1, s, Chr(0)) - 1)
.WinName = s
End With
Next ctr

' We need to perform several modifications to the BLOB data:
'1) Resize the height of each window so that all of the table's fields will
be visible.
' We will have to calculate a new Y1 position after we increate the height
of the window.
'
'2) Resize the width of each window so that the Table name and all of the
' field names will fit. Use a smaller font if the calculated width is
larger
' than our desired max width. Remember, I want to use a fixed width for
the
' columns of our output.
'3)
'
'
' The most difficult issue is to move every window to a column. Basically we
want
' to implement a Snap to Grid effect.
' Here is the logic:
' Loop through all windows
' Find the smallest X1 with the smallest Y1
' This becomes our first window
' Start looping again, this time finding the smallest X1 with the smallest
Y1
' that is larger than the previous Y1. This logic will ensure we are always
working
' down the grid. When we can no longer find any Y1 coords that are larger
than previous
' Y1 we are done this column of the grid. We then start over from the top
again.
' The logic is further constrained each time in the X direction for each
column of
' the grid we are building. X1 must be less than the width of the table at
the
' very top of the column we are currently working on. In other words, the
starting X1
' position of the next table window below the first one in this column must
have a
' starting X1 position less than the X1 + width of the first window in this
column.
' If there are two smaller windows under a wide window, and the second
window's Y1 meets
' the criteria of being larger than the first small window, we will move
this second
' small window directly underneath the first small window. It's the only
exception I
' can think of at this pointin developing this logic.

' Ok, we'll need an array and/or a collection to process implement our
logic.
' We really only need to store each Table name in final desired column
row/order.

' At this point we will not modify the original rl() array.
' Let's try a Collection for now. The key will be the Table Name. We do not
need
' to actually store any data as the order of the Key is what is important.
' Basically using the Collection as an odered list.
' First we find the smallest Y1 with the smallest X1.
' This gives us the topmost window in this column
' Next we search for the smallest X1 with a Y1 that is >= to the previous
Y1.
' We'll copy our rl() array over to a temp Collection
' so that we can remove entries as we process to
' speed up processing.

' Final Output order of windows
Dim cOut As New Collection
' Temp working Collection
Dim cTmp As New Collection

' Current Column Counter
Dim CurCol As Long
' Need to use/store the array index instead of a single instance of Rel
Window structure as VB
' will not accept a structure for the Item param of the Add method of the
Collection object.
'Dim r As RelWindowMin
' Copy to temp Collection
For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
cTmp.Add Item:=ctr, Key:=.WinName
End With
Next ctr

' Non existent seed values
X1Prev = 100000
Y1Prev = 100000
' Find Top and left most window. Smallet X1 and Y1
Dim obj As Variant
Dim sNamePrev As String
' Need to flag when we are at the bottom of a column
'so we can reset seed values.
' No I think we can just keep finding the left most and top most window
' continually until all windows are processed/found.
' SNAP TO GRID
'for i =8 to 80 step 8
'
*************** *************** *************** *************** *************** *************
Dim SpacingInterval As Long

' Add a user defined Left Margin
Dim LeftMargin As Long
LeftMargin = 20
' Force window to multiple of SpacingInterval value.
' if less than halfway then go backwards to previous multiple.
' if more than or equal to halfway then go ahead to next multiple.
SpacingInterval = 100 ' was 200 sat march 11 at 5:57pm200
'For i = 100 To 200 Step 100
' SpacingInterval = i '* 25
For ctr = 0 To rb.NumWindows - 1
' Move to multiple of SpacingInterval
' Move to 0 if X1 is less than SpacingInterval
If rl(ctr).RelWinX 1 <= SpacingInterval Then
rl(ctr).RelWinX 1 = LeftMargin '0
Else
' Calculate which column X1 is in.
lRet = Int(rl(ctr).Rel WinX1 / SpacingInterval )
lTemp = rl(ctr).RelWinX 1 - (SpacingInterva l * lRet)
' Less than half way to next multiple of SpacingInterval
If lTemp <= SpacingInterval / 2 Then
' Move back
lTemp = -lTemp 'SpacingInterva l - lTemp
Else
' More than halfway to next multiple of SpacingInterval
' Move forward
lTemp = SpacingInterval - lTemp
End If
' Update coords
rl(ctr).RelWinX 1 = rl(ctr).RelWinX 1 + lTemp
rl(ctr).RelWinX 2 = rl(ctr).RelWinX 1 + lTemp
rl(ctr).Column = Int(rl(ctr).Rel WinX1 / SpacingInterval )
End If
Next ctr
'Next i

' *************** *
' March 11 9:15pm commented out belwo.
' Its' redundand and alreay done just above.

'' Increase space between SpaceInterval columns
'For ctr = 0 To rb.NumWindows - 1
' ' Add 300 to each SpacingInterval
' ' Determine Column #
' If rl(ctr).RelWinX 1 < SpacingInterval Then
' ' Column = 0
' lRet = 0
' Else
' lRet = Int(rl(ctr).Rel WinX1 / SpacingInterval )
'
' End If
'
' ' Update Column member
' rl(ctr).Column = lRet
' ' Update coords - add min 20 pixels between windows
' ' *************** *************** **********
' 'comment out below March 11-2006
'
'************** *************** *************** *************** ************
'' lTemp = rl(ctr).RelWinX 2 - rl(ctr).RelWinX 1
'' rl(ctr).RelWinX 1 = rl(ctr).RelWinX 1 + (lRet * 20) 'SpacingInterva l)
'100) 'lTemp
'' rl(ctr).RelWinX 2 = rl(ctr).RelWinX 1 + lTemp '(lRet * 400)
''
'Next ctr
' Mon - March 6 10:10pm
' commented out

For ctr = 0 To rb.NumWindows - 1

For Each obj In cTmp
If rl(obj).RelWinX 1 = X1Prev Then
' Still in same column
If rl(obj).RelWinY 1 < Y1Prev Then
Y1Prev = rl(obj).RelWinY 1
X1Prev = rl(obj).RelWinX 1
sNamePrev = rl(obj).WinName
lRet = obj
End If

Else
If rl(obj).RelWinX 1 < X1Prev Then

'If rl(obj).RelWinY 1 = Y1Prev Then
Y1Prev = rl(obj).RelWinY 1
X1Prev = rl(obj).RelWinX 1
sNamePrev = rl(obj).WinName
lRet = obj

'ElseIf rl(obj).RelWinY 1 <= Y1Prev Then

End If
End If

Next obj

' Error checking. Processed all windows
If Len(sNamePrev & vbNullString) = 0 Then Exit For
' Update Column member
' Save off this window in our ordered list
cOut.Add Item:=lRet, Key:=sNamePrev
' Remove this item from the temp work collection
cTmp.Remove sNamePrev
' Reset to non existent seed values
X1Prev = 100000
Y1Prev = 100000
sNamePrev = 0

Next ctr

' When we get to here all windows should have been processed
' and our temp work collection should have been emptied.
'

' Mon - March 6 10:10pm
' commented out
'X1 = 0
'Y1 = 0
'
'
' Make a working copy
ReDim rlTemp(0 To UBound(rl))
rlTemp = rl

' What we want to do is copy, in order, to the rl() array, via the
Collection Item prop
' from the rlTemp() array. This will put the windows in order from the
' top leftmost to the bottom right most. We need to do this so we can
adjust/increase
' the height of each Table windows so that all of the fields will be
visible.
ctr = 0
For Each obj In cOut
With rl(ctr)
.RelWinX1 = rlTemp(obj).Rel WinX1
.RelWinY1 = rlTemp(obj).Rel WinY1
.RelWinX2 = rlTemp(obj).Rel WinX2
.RelWinY2 = rlTemp(obj).Rel WinY2
.WinName = rlTemp(obj).Win Name
.Column = rlTemp(obj).Col umn
ctr = ctr + 1
End With
Next

Dim MaxDocCharWidth As Long
Dim MaxDocCharHeigh t As Long
' Width of max documnentation characters
' Since we are using a 10 point font to calc width but really
' outputting 8 point with a 10 point leading then we do not
' need any extra char spacing.
sText = "XXXXg"
With sRect
.Left = 0
.Top = 0
.Bottom = 0
' Single line TextWidth
.Right = 32000
End With

lRet = apiDrawText(hDC , sText, -1, sRect, DT_CALCRECT Or DT_TOP Or _
DT_LEFT Or DT_WORDBREAK Or DT_EXTERNALLEAD ING Or DT_EDITCONTROL
Or DT_NOCLIP)

MaxDocCharWidth = sRect.Right
' Allow for 14 pt header and 10 point leading
MaxDocCharHeigh t = sRect.Bottom ' * 2

' Since the DyanPDF library will automatically wrap text to the next line
' we have to make sure that the Table name, the field names and the extra
' field documenting characters fit one single lines. Otherwise our logic
' to calculate the beginning and ending points of the Join lines will not be
accurate.
' There is an issue of overlap though in the X dimension when I increase the
width
' of the table window. This is easy to solve in the Y dimension but tougher
in the X direction.
' I may have to set a fixed width for all windows to solve this issue.

' X2Max holds widest Table or Field name.
' Loop through all of the table widths and adjust

' Add extra space in width to allow for documenting chars.

' Let's increase the Width of each Table window so that all fields are
visible.
' Perhaps we should modify the rl structure to hold max width required to
' ensure the table and field names are visible. No let's use a collection
object instead.
' No we will modify as we go - no need to store this value.
X2Max = 0
Y2Max = 0
Dim bHeader As Boolean

For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
' Call our function to calc height
SRelTableName = .WinName '(.WinName) 'StrConv(.WinNa me,
vbFromUnicode)
s = Right$(SRelTabl eName, 3)
lRet = InStr(s, "_")
If lRet = 1 Or lRet = 2 Then
SRelTableName = Mid$(SRelTableN ame, 1, Len(SRelTableNa me) - (4 -
lRet))
End If
' DO NOT need to process this clone/copy - just process main table.
' No we cannot store the original Table window's Max width as it may
not have been
' processed at this point.
'If lRet = 0 Then
Set tdf = db.TableDefs(SR elTableName) '.WinName)
If Not tdf Is Nothing Then
'Calc width of Table name and all Field Names
' Set width of Table window to max width
sText = tdf.Name
With sRect
.Left = 0
.Top = 0
.Bottom = 0
' Single line TextWidth
.Right = 32000
End With

lRet = apiDrawText(hDC , sText, -1, sRect, DT_CALCRECT Or
DT_TOP Or _
DT_LEFT Or DT_WORDBREAK Or DT_EXTERNALLEAD ING Or
DT_EDITCONTROL Or DT_NOCLIP)

X2Max = sRect.Right
bHeader = True

For Each fld In tdf.Fields
sText = fld.Name
With sRect
.Left = 0
.Top = 0
.Bottom = 0
' Single line TextWidth
.Right = 32000
End With

lRet = apiDrawText(hDC , sText, -1, sRect, DT_CALCRECT Or
DT_TOP Or _
DT_LEFT Or DT_WORDBREAK Or DT_EXTERNALLEAD ING Or
DT_EDITCONTROL Or DT_NOCLIP)

If sRect.Right > X2Max Then
X2Max = sRect.Right
bHeader = False
End If
Next

'
*************** *************** *************** **************
' Make this a user optional param
' Resize to width ALL WINDOWS
' Get current width of this window. If it is less than X2Max
then adjust.
'If .RelWinX2 - .RelWinX1 < X2Max + MaxDocCharWidth Then
If bHeader = True Then
.RelWinX2 = .RelWinX1 + X2Max + MaxDocCharWidth
Else
.RelWinX2 = .RelWinX1 + X2Max + MaxDocCharWidth
End If
Set fld = Nothing
X2Max = 0

End If
'End If

End With
Next ctr
Set tdf = Nothing


' *****
' Adjust Height of all Relationship Table windows.
' *****

' Let's increase the Width of each Table window so that all fields are
visible.
' Perhaps we should modify the rl structure to hold max width required to
' ensure the table and field names are visible. No let's use a collection
object instead.
' No we will modify as we go - no need to store this value.
X2Max = 0
Y2Max = 0
For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
' Call our function to calc height
SRelTableName = .WinName '(.WinName) 'StrConv(.WinNa me,
vbFromUnicode)
s = Right$(SRelTabl eName, 3)
lRet = InStr(s, "_")
If lRet = 1 Or lRet = 2 Then
SRelTableName = Mid$(SRelTableN ame, 1, Len(SRelTableNa me) - (4 -
lRet))
End If
' DO NOT need to process this clone/copy - just process main table.
' No we cannot store the original Table window's Max width as it may
not have been
' processed at this point.
'If lRet = 0 Then

' Build our string starting with Relationship Table window name
sText = SRelTableName & vbCrLf

Set tdf = db.TableDefs(SR elTableName) '.WinName)
If Not tdf Is Nothing Then
' Add individual Field names

For Each fld In tdf.Fields
sText = sText & fld.Name & vbCrLf
Next
With sRect
.Left = 0
.Top = 0
.Bottom = 0
' Single line TextWidth
.Right = 30000 'rl(ctr).RelWin X2 - rl(ctr).RelWinX 1
End With

lRet = apiDrawText(hDC , sText, -1, sRect, DT_CALCRECT Or
DT_TOP Or _
DT_LEFT Or DT_WORDBREAK Or DT_EXTERNALLEAD ING Or
DT_EDITCONTROL Or DT_NOCLIP)
Y2Max = sRect.Bottom

' Get current height of this window. If it is less than calc
Height then adjust.
' We also need to leave room for an extra row to allow for
the
' Total Recs: line we output
If .RelWinY2 - .RelWinY1 < Y2Max + MaxDocCharHeigh t Then
.RelWinY2 = .RelWinY1 + Y2Max + MaxDocCharHeigh t
End If
Set fld = Nothing

End If
'End If
' ***
'************** *************** *************** ***
' March 11/2006
' Add code here to set each window to the start of the column.
' Allow user to specify MinColumnSpacin g
Dim MinColumnSpacin g As Long

MinColumnSpacin g = 40
' SpacingInterval contains relative offset


End With
Next ctr
Set tdf = Nothing
Set fld = Nothing



' March 6 -2006 10:18pm
' COMMENTED out below
' *****
' Adjust Starting X1 ANd Y1 of all Relationship Table windows.
' *****

' Let's increase the X1 starting X position of each Table window in order to
' increase the spacing between each table. We do this because overlapping
conditions
' are created when we previously increased the width of each Table window.
' To keep this simple, we allow the user to specify a fixed amount for the
' spacing value.
' Since our array of Rel() structures is ordered from top leftmost to
' bottom right most we can basically process the windows in a column by
column order.
'
' Because the spacing has to be cumulative per increasing column position,
we multiply
' the user's desired spacing value by the current column count(zero
indexed).

' Let's increase the Y1 starting Y position of each Table window in order to
' ensure that Table Windows do not overlape. We do this because overlapping
conditions
' are created when we previously increased the Height of each Table window
in order to
' ensure that all fields in the table window are visible.
Dim ctrCol As Long
'Dim Y1Prev As Long,
Dim Y2Prev As Long
Dim Y2PrevOrig As Long, Y1PrevOrig As Long
Dim VerticalWindowS pacing As Long

VerticalWindowS pacing = 14
Y1Prev = 0
Y2Prev = 0
X2Max = 0
Y2Max = 0
ctrCol = 0

Y2PrevOrig = 0
Y1PrevOrig = 99999999
For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
' Modify Y1 first
' First window in the array is the topmost - leftmost window
' Determine if we are still in the current column.
' If the Y1 of this window is Greater than the Y1 of the
' previous window then we are still in the same column.
' Do need to code exception to handle when this current window
' is in the next column because even though the this Y1 is greater
' than previous Y1, X1 actually places this window in the next
column.(I think):-)
If .RelWinY1 > Y1PrevOrig Then
' We're still in the same column
' Store Y1
Y1PrevOrig = .RelWinY1
' Are we overlapping the previous window in this column.
If (.RelWinY1 < Y2Prev + VerticalWindowS pacing) And Y2Prev <> 0
Then
' Reposition to avoid overlap - calc resize first
.RelWinY2 = (.RelWinY2 - .RelWinY1) + Y2Prev +
VerticalWindowS pacing
.RelWinY1 = Y2Prev + VerticalWindowS pacing

' Y2Prev = .RelWinY2
' Y1Prev = .RelWinY1

'Else

End If
Y2Prev = .RelWinY2
Y1Prev = .RelWinY1

Else
' We're in the next column. Do not resize as it is the top most
' window in this column. Reset seeds to non existent values.
' Next Column
ctrCol = ctrCol + 1
Y2Prev = .RelWinY2
Y1Prev = .RelWinY1
Y1PrevOrig = .RelWinY1 '0
' Since we are at top of column no need to reposition

End If

End With
Next ctr


' Set absolute position for start of each column.
' Find Max Width of all windows in each column to calc ColumnWidth
' Storage for column Widths
Dim aColWidths() As Long

Dim lNumColumns As Long

' Get Total number of columns
For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
If lNumColumns < .Column Then lNumColumns = .Column
End With
Next ctr
ReDim aColWidths(0 To lNumColumns)
Dim Gutter As Long
Gutter = 20

' Find largest window width in each column and
' store this value in our column width array.
For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
If (.RelWinX2 - .RelWinX1) > aColWidths(.Col umn) Then
aColWidths(.Col umn) = (.RelWinX2 - .RelWinX1)
End If
End With
Next ctr
' Set X1 for every table window to the calc start of the column.
' *************** **************
' Here we can set the Left Margin
For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
' Column starting position =
' column widths for all previous columns plus
' column spacing value
lTemp = 0
For i = 0 To .Column - 1
lTemp = lTemp + aColWidths(i)
lTemp = lTemp + Gutter
Next i
.RelWinX2 = (.RelWinX2 - .RelWinX1) + lTemp
.RelWinX1 = IIf(lTemp = 0, LeftMargin, lTemp)

End With
Next ctr


' Loop through all Relationship Table windows to get
' the largest X2 and Y2 coordinates.
' Modify the starting Y1 coordinate for all Table Windows
' to allow for 1 inch Header section.
' Finally convert Window coords to 72 PPI used by the DynaPDF library
'

X2Max = 0
Y2Max = 0
For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
.RelWinX1 = (.RelWinX1 / Xdpi) * 72
.RelWinX2 = ((.RelWinX2 / Xdpi) * 72) ' + 16
.RelWinY1 = ((.RelWinY1 / Ydpi) * 72) '+ 16 ' Space for header
section
.RelWinY2 = ((.RelWinY2 / Ydpi) * 72) '+ 6 ' Space for header
section
End With

X2 = rl(ctr).RelWinX 2
Y2 = rl(ctr).RelWinY 2
If X2Max < X2 Then X2Max = X2
If Y2Max < Y2 Then Y2Max = Y2
Next ctr

ctr = 0

' 1) We will have to widen each window to accomodate Allen Browne's
' documentation character symbols.
'
' 2) To make it simpler to create the windows in the PDF document
' I want to make each window the same width.

' In the next release I'll add a param to this function to allow
' the user to specify the desired width.

' So I'll need a function or functions in the StrStorage DLL

Dim sFields As String
Dim sPDF As String

sPDF = "C:\sourcecode\ ReportToPDF\Rel ations.pdf"
' Should calc string width of Allen's Documentation Characters
' instead of using the fixed value of 16 Points.
' We also need to allow space for a Header or Footer
lRet = BeginPDF(sPDF, X2Max + 32, Y2Max + 32)

'GoTo HHH

' The first time through we will just gather the necessary info
' to allow us to draw the Relationship Join lines.
' We will need to store
' Table Name(to index into the Relation object)
' Table Ypos
' Field Name(to index into Relation object)
' Field Pos - 1 to num fields
For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
On Error Resume Next
SRelTableName = .WinName
Set tdf = Nothing
' We don't have to remove _1(_x) from end of WinName because the
Relation object
' only stores relations under the original table name - Customers
not Customers_1.
' We know it is a Clone/Copy of the Table when the Table and
ForeightTable props
' are the same. We can then examine the Name prop, specifically the
last char
' to tell what instance of the clone/copy we are working with.
' First instance is Customers_1 then Customers_2 etc. But this logic
does not
' carry over to the Name prop of the Relation object.
' Customers_1 = CustomersCustom ers
' Customers_2 = CustomersCustom ers_1
'etc
' s = Right$(SRelTabl eName, 3)
' lRet = InStr(s, "_")
' If lRet = 1 Or lRet = 2 Then SRelTableName = Mid$(SRelTableN ame, 1,
Len(SRelTableNa me) - (4 - lRet))
'

Set tdf = db.TableDefs(SR elTableName)
If Not tdf Is Nothing Then
'Get Field Name + Documenting info
'sFields = DescribeFields( tdf)
'lngKt = lngKt + 1& 'Count the tables processed successfully.
' See if there are any matching Relation entries.
' If there are then store the required information
' to allow us to draw the Relationship table/field Lines
For Each rel In db.Relations
If rel.Table = .WinName Then ' Then
' There is a matching relation for this Relationship
Window Table.
' We need to find the rel field for this entry and
' store the absolute position of this field in the
table->fields collection.
' We cannot draw the line now as the matching rel table
may not
' have been drawn yet. Remember, we must draw all of the
Relationship lines
' BEFORE we draw the Table windows as the Rel Lines must
appear
' behind the Table windows.
' We can use the OrdinalPosition property of the field
but it must be in
' the Table object not the Relationship object.
OrdinalPosition is a
' zero based prop.
' We then will use the same logic as above to determine
the absolute
' position of the matching ForeignName Field for the
ForeignTable
' component of this Relationship.
' Do we need to store this information at all? I mean
since the
' OrdinalPosition prop is available for Relationship
fields we do not
' need to store it. Also since the absolute position of
each
' Relationship Table window is known/calculated why
can't I simply
' loop through the Relations collection and render the
Lines when the
' Table prop of the Relation object has a matching entry
in the
' Relationship window BLOB data?
' Draw the Line for this Relationship
' Get the Ordinal Position of the Primary and
ForeignTable fields
Set fld = rel.Fields(0)

ReOPp = tdf.Fields(fld. Name).OrdinalPo sition

' Check if ForeignTable prop is a Clone/Copy
lRet = 0
If rel.Table = rel.ForeignTabl e Then
' Determine which copy(_x) this one is
If Len(rel.Table) * 2 = Len(rel.Name) Then
s = rel.ForeignTabl e & "_" & 1
lRet = 1
Else
' Grab last character of Name prop. This logic
will
' only support to a max of 9 clones/copies
s = Right$(rel.Name , 1)
s = rel.ForeignTabl e & "_" & Val(s) + 1
lRet = 1
End If

End If

Set tdfForeign = db.TableDefs(re l.ForeignTable)
ReOPf =
tdfForeign.Fiel ds(fld.ForeignN ame).OrdinalPos ition + 1

' Calc the start and ending X,Y cordinates for the
' Relationship Line we are going to draw.
X1 = .RelWinX1 '(.RelWinX1 / Xdpi) * 72
Y1 = .RelWinY1 '(.RelWinY1 / Ydpi) * 72
' Now we need to add an offset to Y1 to bring us down to
' the row containing the relationship field. Since the
' OrdinalPosition index is zero based we don't have to
add 1
' to cover the fact that we output a row first
containing
' the Table name. 10 pts is the row spacing.
Y1 = Y1 + (IIf(ReOPp = 0, 1, ReOPp) * 10)
' Now we need to find X1 and Y1 for the Foreign Table
' Find it in the Rel BLOB data.
' Need to allow logic to determine on which side(left or
right)
' we want the Relationship Line to start from.
' If the left edge of the Foreign table window is <= to
the
' center of the Primary Table then the Joining line will
originate from
' the left side of the Primary table. Otherwise, it will
originate
' from the right side of the Primary table
If lRet = 0 Then
s = rel.ForeignTabl e
End If

For i = 0 To rb.NumWindows - 1
If rl(i).WinName = s Then 'rel.ForeignTab le Then
'If Trim(rl(i).WinN ame) = rel.ForeignTabl e Then
X2 = (rl(i).RelWinX1 )
Y2 = (rl(i).RelWinY1 )
Y2 = Y2 + (IIf(ReOPf = 0, 1, ReOPf) * 10)
' Which side of Primary table does the Join line
' originate from left/right.
' Handled in StrStorage DLL by DrawLine function
lRet = DrawLine(.RelWi nX2 - .RelWinX1,
rl(i).RelWinX2 - rl(i).RelWinX1, _
X1, Y1, X2, Y2, lRet)
End If
Next i

Set fld = Nothing
Set tdfForeign = Nothing
End If
Next

End If

End With
Set tdf = Nothing
Next ctr
HHH:
' Output Header before Table Windows
' Pass 0 in NumFields param to signal this is Header info.
' Pass desired Header info in TableNames param.
' Coordinate params will be used to position Header
' We have modified the starting Y1 coordinate for all Table Windows
' to allow for 1 inch Header section.
'SRelTableName = "RelationSh ip Report:" & Date & Chr(0) 'vbCrLf
's = CurrentDb().Nam e & Chr(0)
'lRet = DrawTableWindow (SRelTableName, s, 0, _
' 10, 10, 400, -1)
' Main loop to actually draw each Relationship Table window
' and the Tables component fields.
For ctr = 0 To rb.NumWindows - 1
With rl(ctr)
On Error Resume Next
SRelTableName = .WinName '(.WinName) 'StrConv(.WinNa me,
vbFromUnicode)
s = Right$(SRelTabl eName, 3)
lRet = InStr(s, "_")
If lRet = 1 Or lRet = 2 Then SRelTableName = Mid$(SRelTableN ame, 1,
Len(SRelTableNa me) - (4 - lRet))
Set tdf = db.TableDefs(SR elTableName)
If Not tdf Is Nothing Then
'Get Field Name + Documenting info
sFields = DescribeFields( tdf)
'lngKt = lngKt + 1& 'Count the tables processed successfully.
End If

' lRet = DrawTableWindow (SRelTableName, sFields, rb.NumWindows, _
' (.RelWinX1 / Xdpi) * 72, (.RelWinY1 / Ydpi) * 72, (((.RelWinX2 -
..RelWinX1) / Xdpi) * 72) + 12, ((.RelWinY2 - .RelWinY1) / Ydpi) * 72)
lRet = DrawTableWindow (.WinName, sFields, rb.NumWindows, _
.RelWinX1, .RelWinY1, (.RelWinX2 - .RelWinX1), (.RelWinY2 -
..RelWinY1))
End With
Set tdf = Nothing
Next ctr
' Do we open new PDF in registered PDF viewer on this system?
'If StartPDFViewer = True Then
ShellExecuteA Application.hWn dAccessApp, "open", sPDF, vbNullString,
vbNullString, 1
'End If

On Error GoTo 0

lRet = EndPDF

RelationsToPDF = True

EXIT_RelationsT oPDF:

Set db = Nothing
Set tdf = Nothing
Set fld = Nothing
Set rel = Nothing

' If we aready loaded then free the library
If hLibStrStorage <> 0 Then
hLibStrStorage = FreeLibrary(hLi bStrStorage)
End If

If hLibDynaPDF <> 0 Then
hLibDynaPDF = FreeLibrary(hLi bDynaPDF)
End If
' Cleanup
lRet = apiSelectObject (hDC, oldfont)
' Delete the Font we created
apiDeleteObject (newfont)

' Release the handle to the Screen's DC
lRet = apiReleaseDC(0& , hDC)

Exit Function

ERR_RelationsTo PDF:
MsgBox Err.Description , vbOKOnly, Err.Source & ":" & Err.Number

RelationsToPDF = False
Resume EXIT_RelationsT oPDF


End Function


Jun 25 '06 #5

This thread has been closed and replies have been disabled. Please start a new discussion.

Similar topics

8
2093
by: Steve Jorgensen | last post by:
Hi all, I was wondering if anyone has been able to find a way to read layout information and manipulate the layout in the Relationships window. I've tried a few different angles, but couldn't find anything. Thanks, - Steve J.
17
2805
by: Jelmer | last post by:
Hi, I am mildly familiar with ms access developement and I have been asked to port and document a ms access app. I expect the porting (97 to XP) to be fairly straightforward. However documenting it is another matter. How do you people document your access apps? Just create an ERD and have comments in the vba code? List all the forms and it's purpose ? Are there any methodologies / best practices / examples I can look at? thanks in...
2
1788
by: DataB | last post by:
Hi everyone! I have a forms problem. Bakground: I have created a number of tables. Of these, I have a main parent table (Personal Details) and a number of other child tables (Tax file No., VISA card no.), etc...... All tables have a primary key of "Name", all child tables forming
7
2164
by: Ruben Baumann | last post by:
Just wondered if anyone has had occasion to use, or does use, FileMaker, or Raining Data's Omnis, or Alpha5's software, and how they compare with Access? Ruben
3
1860
by: Tom van Stiphout | last post by:
I have written some code to export all objects to text files, and to import those files back into a new database. Hopefully this will eliminate some forms of corruption. The icing on the cake would be to copy the relationships window as well. So far, I was trying this code below, but it doesn't work. First off, I'm surprised that on several MDBs the count of objects is 2. I was expecting 1 because an MDB can have only 1 relationship...
45
3399
by: salad | last post by:
I'm curious about your opinion on setting relationships. When I designed my first app in Access I'd go to Tools/Relationships and set the relationships. Over time I'd go into the window and see relationship spaghetti....tables/queries all overthe place with lots of relationship lines between here and there. After that first app I didn't do relationships. If I had a query, I defined the relationship. Many of the times when I create a...
7
2742
by: Craig Alexander Morrison | last post by:
Warning to Access Developers about ACE. DON'T use multivalued fields (MVF) they are worse than LookUp fields and SubDatasheets, in fact they (MVFs) are a logical progression in the dumbing down that started with these abominations. Having seen and evaluated Access 2007 for a few months now I think this is a terrible product for developers. If you must use it use Jet 4 or SQL Server 2000 or IBM DB2* as the backend, depending upon your...
2
1666
by: anthony | last post by:
I have an old database which started out life in the Access 2 days! It's full of lots of stuff which I'm not convinced is relevant any longer. Would a good way forward be to create a new, blank database in Access 2007 and then import the existing objects, re-create the relationships etc? That way I can just bring in the stuff that's currently in use and, hopefully, have a better chance of avoiding database corruption. The alternative, I...
5
2107
by: terrybell105 | last post by:
I downloaded Stephan's utility from his website but can't get it to work - or maybe I'm not driving it properly! The form works OK with the existing 3 "views" - I can switch between them and they display changes fine. But if I add or remove a table from any one of them, strange things happen. For example: start with a fresh copy of the downloaded database. Open the form and click on the "Admin" view. Right click and click on "Show Table"...
0
8821
marktang
by: marktang | last post by:
ONU (Optical Network Unit) is one of the key components for providing high-speed Internet services. Its primary function is to act as an endpoint device located at the user's premises. However, people are often confused as to whether an ONU can Work As a Router. In this blog post, we’ll explore What is ONU, What Is Router, ONU & Router’s main usage, and What is the difference between ONU and Router. Let’s take a closer look ! Part I. Meaning of...
0
8718
by: Hystou | last post by:
Most computers default to English, but sometimes we require a different language, especially when relocating. Forgot to request a specific language before your computer shipped? No problem! You can effortlessly switch the default language on Windows 10 without reinstalling. I'll walk you through it. First, let's disable language synchronization. With a Microsoft account, language settings sync across devices. To prevent any complications,...
1
9103
by: Hystou | last post by:
Overview: Windows 11 and 10 have less user interface control over operating system update behaviour than previous versions of Windows. In Windows 11 and 10, there is no way to turn off the Windows Update option using the Control Panel or Settings app; it automatically checks for updates and installs any it finds, whether you like it or not. For most users, this new feature is actually very convenient. If you want to control the update process,...
1
6646
isladogs
by: isladogs | last post by:
The next Access Europe User Group meeting will be on Wednesday 1 May 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM). In this session, we are pleased to welcome a new presenter, Adolph Dupré who will be discussing some powerful techniques for using class modules. He will explain when you may want to use classes instead of User Defined Types (UDT). For example, to manage the data in unbound forms. Adolph will...
0
5967
by: conductexam | last post by:
I have .net C# application in which I am extracting data from word file and save it in database particularly. To store word all data as it is I am converting the whole word file firstly in HTML and then checking html paragraph one by one. At the time of converting from word file to html my equations which are in the word document file was convert into image. Globals.ThisAddIn.Application.ActiveDocument.Select();...
0
4477
by: TSSRALBI | last post by:
Hello I'm a network technician in training and I need your help. I am currently learning how to create and manage the different types of VPNs and I have a question about LAN-to-LAN VPNs. The last exercise I practiced was to create a LAN-to-LAN VPN between two Pfsense firewalls, by using IPSEC protocols. I succeeded, with both firewalls in the same network. But I'm wondering if it's possible to do the same thing, with 2 Pfsense firewalls...
0
4738
by: adsilva | last post by:
A Windows Forms form does not have the event Unload, like VB6. What one acts like?
1
3175
by: 6302768590 | last post by:
Hai team i want code for transfer the data from one system to another through IP address by using C# our system has to for every 5mins then we have to update the data what the data is updated we have to send another system
3
2118
bsmnconsultancy
by: bsmnconsultancy | last post by:
In today's digital era, a well-designed website is crucial for businesses looking to succeed. Whether you're a small business owner or a large corporation in Toronto, having a strong online presence can significantly impact your brand's success. BSMN Consultancy, a leader in Website Development in Toronto offers valuable insights into creating effective websites that not only look great but also perform exceptionally well. In this comprehensive...

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.