René Nyffenegger's collection of things on the web
René Nyffenegger on Oracle - Most wanted - Feedback -
 

Macro to have print four addresses on one page [Winword]

This macro is a sort of VBA-Only method to create a form letter.
The problem it addresses is that it seemed quite problematic (at least to me) to print four addresses on one page with Word's VBA. Therefore, the following script creates a text box for each address and lays them out on a page.
of course, this is only a basic framework upon which it should be worked on. 
option explicit

const bmCurPageTopLeftPara = "bm1"

dim addressFromLeft as double
dim addressFromTop  as double
dim addressWidth    as double
dim addressHeight   as double
dim midFromLeft     as double
dim midFromTop      as double
dim border          as double

dim curItem         as long

sub test()

    dim wor as application
    dim doc as document

  ' Keep track which quadrant on the 'current page' is
  ' being written to.
    curItem = 0

    set doc = init()

    call addAddress(doc, "Mr Smith"         , "1029 Banana Street", "82904 Outtheria"    )
    call addAddress(doc, "Maria Ortega"     , "Court Road"        , "22222 To two, Too"  )
    call addAddress(doc, "Peter Stone"      , "Milky Way"         , "Far and away"       )
    call addAddress(doc, "Lucky Luke"       , "One Saloon"        , "In the West"        )
    call addAddress(doc, "Huckleberry Finn" , "813 Mississippi"   , "In the South"       )
    call addAddress(doc, "AAAAAA AA  AAAA"  , "1 AAAAAAAAAAAAA"   , "AAAAAAA AAAA"       )
    call addAddress(doc, "BBBBBB BB  BBBBB" , "2 BBBBBBBBBBBBB"   , "22222 BBBBBBB BBBB" )
    call addAddress(doc, "CCCCCC CC  CCCCC" , "3 CCCCCCCCCCCCC"   , "33333 CCCCCCC CCCC" )
    call addAddress(doc, "DDDDDD DD  DDDDD" , "4 DDDDDDDDDDDDD"   , "44444 DDDDDDD DDDD" )
    call addAddress(doc, "EEEEEE EE  EEEEE" , "5 EEEEEEEEEEEEE"   , "55555 EEEEEEE EEEE" )
    call addAddress(doc, "FFFFFF FF  FFFFF" , "6 FFFFFFFFFFFFF"   , "66666 FFFFFFF FFFF" )
    call addAddress(doc, "GGGGGG GG  GGGGG" , "7 GGGGGGGGGGGGG"   , "77777 GGGGGGG GGGG" )
    call addAddress(doc, "HHHHHH HH  HHHHH" , "8 HHHHHHHHHHHHH"   , "88888 HHHHHHH HHHH" )
    call addAddress(doc, "IIIIII II  IIIII" , "9 IIIIIIIIIIIII"   , "99999 IIIIIII IIII" )

end sub

function init() as document
    dim sel as selection

  ' Initialize pseudo constants.

    addressFromLeft = centimetersToPoints(8  )
    addressFromTop  = centimetersToPoints(4  )
    addressHeight   = centimetersToPoints(3  )
    addressWidth    = centimetersToPoints(5  )
    midFromLeft     = centimetersToPoints(14.8)
    midFromTop      = centimetersToPoints(10.5)
    border          = centimetersToPoints(1   )

  
  ' The new document
    set init = documents.add
  
    set sel = selection
  
      
    init.bookmarks.add range := sel.range, name := bmCurPageTopLeftPara
    sel.typeParagraph
  
    sel.pageSetup.orientation    = wdOrientLandscape
    sel.pageSetup.topMargin      = border
    sel.pageSetup.leftMargin     = border
    sel.pageSetup.rightMargin    = border
    sel.pageSetup.bottomMargin   = border

end function


sub nextPage(doc as document, sel as selection)

    dim ran as range
    set ran = doc.goto(what := wdGotoBookmark, name := bmCurPageTopLeftPara)
    ran.select

    sel.moveDown unit:=wdLine, count := 1

    sel.insertBreak type := wdPageBreak

    doc.bookmarks.add range := sel.range, name := bmCurPageTopLeftPara
    sel.typeParagraph

end sub

sub addAddress(doc as document, line1 as string, line2 as string, line3 as string) 

    dim left as double
    dim top  as double
    dim txb  as shape
    dim sel  as selection

    select case curItem

      case 0

        left = 0
        top  = 0

        curItem = 1

      case 1

        left = 0
        top  = midFromTop

        curItem = 2

      case 2
       
        left = midFromLeft
        top  = 0

        curItem = 3

      case 3

        left = midFromLeft
        top  = midFromTop

        curItem = 0

    end select

    left = left + addressFromLeft - border
    top  = top  + addressFromTop  - border

  ' Use the page's top paragraph as anchor.
  ' First: go to the bookmark...
    dim ran as range
    set ran = doc.goto (what := wdGotoBookmark, name := bmCurPageTopLeftPara)
  ' ... then select it.
    ran.select

    set sel=selection

    set txb = doc.shapes.addTextbox(msoTextOrientationHorizontal, left, top, addressWidth, addressHeight, sel)
    txb.select

    sel.typeText text := line1
    sel.typeParagraph
    sel.typeText text := line2
    sel.typeParagraph
    sel.typeText text := line3


    if curItem = 0 then
       call nextPage(doc, sel)
    end if

end sub