Public Function WriteCatalog() ' Copyright 2003 Max Dunn, Silicon Publishing, www.siliconpublishing.com, maxdunn@siliconpublishing.com ' Template designed by Stephen Gilkes ' Discussion thread: http://www.adobeforums.com/cgi-bin/webx?13@@.1de9c708 ' Use this code freely, give credit where appropriate ' Not responsible for whatever you do with it... ' VARIABLE DECLARATIONS Dim db As DAO.Database ' this database Dim rs As DAO.Recordset ' the recordset based on the query Dim oInDesign As InDesign.Application ' the InDesign application Dim oDocument As InDesign.Document ' the document we'll be creating Dim oBorderRect As InDesign.Rectangle ' the border of a product entry Dim oPage As InDesign.Page ' the page we're currently on Dim oImageRect As InDesign.Rectangle ' the rectangle frame containing the image Dim oDescText As InDesign.TextFrame ' the textframe containing description of image Dim oPoints As InDesign.InsertionPoints ' insertion points in story of text frame Dim oPoint As InDesign.InsertionPoint ' current insertion point Dim oDividingLIne As InDesign.GraphicLine ' line between image and description Dim iRowCounter As Integer ' counter of which row we're on Dim iColCounter As Integer ' counter of which column we're on Dim dRectWidth As Double ' width of rectangles, textframe, line Dim dRectHeight As Double ' height of main outer box Dim dImageHeight As Double ' height of image Dim dTextFrameHeight As Double ' height of textframe Dim dInitialXPos As Double ' X position of first box Dim dInitialYPos As Double ' Y position of first box Dim dColSpace As Double ' space between columns Dim dRowSpace As Double ' space between rows Dim dX1, dY1, dX2, dY2 As Double ' X1, Y1, X2, Y2 variables used for geometric bounds Dim sImagePath As String ' path and file name of image being place Dim sBuf As String ' buffer variable for fields pulled from database ' INITIALIZE OBJECTS AND VARIABLES Set db = CurrentDb ' set the database variable to this database Set rs = db.OpenRecordset("qryOutput") ' set the recordset to qryOutput Set oInDesign = CreateObject("InDesign.Application.CS") ' Open Indesign Set oDocument = oInDesign.Open(CurrentProject.Path & "\StartTemplate.indd") ' Open the starting template oDocument.ViewPreferences.HorizontalMeasurementUnits = idMSMillimeters oDocument.ViewPreferences.VerticalMeasurementUnits = idMSMillimeters Set oPage = oDocument.Pages.Item(1) ' Set page to the first page of document dRectWidth = 63.3333 ' width of rectangles, textframe, line dRectHeight = 68 ' height of containing rectangle dImageHeight = 36 ' height of image dTextFrameHeight = 32 ' height of textframe containing descriptive text dInitialXPos = 5 ' X position of first box dInitialYPos = 5 ' Y position of first box dColSpace = 5 ' space between columns dRowSpace = 5 ' space between rows iColCounter = 1 ' initialize column counter iRowCounter = 1 ' initialize row counter ' LOOP THROUGH RECORDSET, CREATING CATALOG Do While Not rs.EOF ' Determine which column/row we're on, add a page if need be If iColCounter = 4 Then iColCounter = 1 ' Only up to 3 columns iRowCounter = iRowCounter + 1 If iRowCounter = 5 Then ' Add a new page when colcounter 4, rowcounter 5 Set oPage = oDocument.Pages.Add iRowCounter = 1 ' Reset row counter End If End If ' OUTER RECTANGLE ' Figure out geometric bounds of rectangle based on row and column ' these coordinates will be referenced to define bounds of all subsequent objects as well dX1 = dInitialXPos + (iColCounter - 1) * (dRectWidth + dColSpace) dY1 = dInitialYPos + (iRowCounter - 1) * (dRectHeight + dRowSpace) dX2 = dX1 + dRectWidth dY2 = dY1 + dRectHeight Set oBorderRect = oPage.Rectangles.Add ' Add the rectangle oBorderRect.GeometricBounds = Array(dY1, dX1, dY2, dX2) ' set bounds of rectangle oBorderRect.StrokeWeight = 1 ' set stroke weight oBorderRect.StrokeColor = oDocument.Swatches.Item("Black") ' set stroke color ' IMAGE Set oImageRect = oPage.Rectangles.Add ' add the rectangle frame where the image will go dY2 = dY1 + dImageHeight ' all the bounds are the same as outer rectangle except Y2 oImageRect.GeometricBounds = Array(dY1, dX1, dY2, dX2) ' set bounds sImagePath = CurrentProject.Path & "\Images\" & rs.Fields("ImageName") oImageRect.Place sImagePath oImageRect.Fit idProportionally oImageRect.Fit idCenterContent oImageRect.SendToBack ' LINE ' X1 will be same as dX1 above ' Y1 and Y2 will be the same as dY2 above ' X2 will be same as dX2 above Set oDividingLIne = oPage.GraphicLines.Add oDividingLIne.GeometricBounds = Array(dY2, dX1, dY2, dX2) ' set bounds oDividingLIne.StrokeWeight = 1 ' set stroke weight oDividingLIne.StrokeColor = oDocument.Swatches.Item("Black") ' set stroke color ' TEXT FRAME ' X1, X2 same as dX1 and dX2 above ' Y1 is Y2 above, ' Y2 is Y2 above plus dTextFrameHeight dY1 = dY2 dY2 = dY1 + dTextFrameHeight Set oDescText = oPage.TextFrames.Add ' create the text frame oDescText.GeometricBounds = Array(dY1, dX1, dY2, dX2) ' set its bounds oDescText.TextFramePreferences.InsetSpacing = Array(2, 2, 0, 2) ' set the inset spacing (t,l,b,r) Set oPoints = oDescText.ParentStory.InsertionPoints ' get collection of insertion points for writing text ' Product code Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Body Text") ' set the paragraph style... this will last for the whole text frame oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Bold") ' set the character style to bold for this insertion point oPoint.Contents = "Product Code: " & vbTab ' static text for product code field Set oPoint = oPoints.Item(oPoints.Count) ' get the next insertion point oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Plain") ' set the character style to none for this insertion point sBuf = rs.Fields("ProductCode") oPoint.Contents = sBuf & vbLf ' output the product code value and linefeed ' Manufacturer Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Body Text") ' set the paragraph style... this will last for the whole text frame oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Bold") ' set the character style to bold for this insertion point oPoint.Contents = "Manufacturer: " & vbTab ' static text for manufacturer field Set oPoint = oPoints.Item(oPoints.Count) ' get the next insertion point oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Plain") ' set the character style to none for this insertion point sBuf = rs.Fields("Manufacturer") oPoint.Contents = sBuf & vbLf ' output the manufacturer and linefeed ' Category Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Body Text") ' set the paragraph style... this will last for the whole text frame oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Bold") ' set the character style to bold for this insertion point oPoint.Contents = "Category: " & vbTab ' static text for Category field Set oPoint = oPoints.Item(oPoints.Count) ' get the next insertion point oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Plain") ' set the character style to none for this insertion point sBuf = rs.Fields("Category") oPoint.Contents = sBuf & vbLf ' output the Category and linefeed ' Retail Price Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Body Text") ' set the paragraph style... this will last for the whole text frame oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Bold") ' set the character style to bold for this insertion point oPoint.Contents = "Retail Price: " & vbTab ' static text for Retail Price field Set oPoint = oPoints.Item(oPoints.Count) ' get the next insertion point oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Plain") ' set the character style to none for this insertion point sBuf = rs.Fields("Retail Price") oPoint.Contents = sBuf & vbTab ' output the Retail Price and tab ' Sale Price Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Body Text") ' set the paragraph style... this will last for the whole text frame oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Bold") ' set the character style to bold for this insertion point oPoint.Contents = "Sale Price: " & vbTab ' static text for Sale Price field Set oPoint = oPoints.Item(oPoints.Count) ' get the next insertion point oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Plain") ' set the character style to none for this insertion point sBuf = rs.Fields("Sale Price") oPoint.Contents = sBuf & vbLf ' output the Sale Price and linefeed ' Description Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Body Text") ' set the paragraph style... this will last for the whole text frame oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Bold") ' set the character style to bold for this insertion point oPoint.Contents = "Description: " & vbTab ' static text for Description field Set oPoint = oPoints.Item(oPoints.Count) ' get the next insertion point oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item("Plain") ' set the character style to none for this insertion point sBuf = rs.Fields("Description") oPoint.Contents = sBuf & vbLf ' output the Description and linefeed iColCounter = iColCounter + 1 ' increment column counter rs.MoveNext ' move to the next record Loop ' CLOSE UP: SAVE CATALOG AND DESTROY OBJECTS oDocument.Save oDocument.Save (CurrentProject.Path & "\Catalog.indd") ' save document rs.Close ' close recordset db.Close ' close database Set rs = Nothing ' explicitly destroy rs object Set db = Nothing ' explicitly destroy db object End Function