Set Individual Column Widths in Word Table 2

[lespaul]

I am trying to create a macro in Word to call from my Delphi application. What I want to do is after each query result (which I can already get into the document) is insert a one row table.

But, I really don't know VBA, I can fumble my way through recording macros, but I'm having some issues. So, I apologize for the code upfront, but it's MS's fault!

So I want to send my data and create a table with the fixed column widths. Send another set of data and create a second table and again until I get to the end of my dataset.

I would appreciate anyone's help in fixing my code!

leslie

Sub MakeTable()
'
' MakeTable Macro
' Macro recorded 4/1/2004 by Leslie
'

Dim tablecount As Integer
    If ActiveDocument.Tables.Count <> 0 Then
      tablecount = ActiveDocument.Tables.Count
    Else
      tablecount = 0
    End If
    tablecount = tablecount + 1
    
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
        7, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
    Selection.Tables(tablecount).Columns(tablecount).PreferredWidth = InchesToPoints(0.7)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(1.88)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(0.63)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(2.13)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(0.5)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(1.75)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(0.5)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
End Sub

 

[Loomah]

Hi Leslie
This is all quite new to me so I'm only making assumptions on the problems you may have encountered.

After cutting your code down I discovered that it failed if there wasn't a gap between the tables. I can only assume that if there is no gap then the tables merge into one and so the indexing is wrong. To get around this I have added a couple of lines at the bottom to move out of the table and add a paragraph.

Hope it's of some help!

Sub MakeTable2()
'
' MakeTable Macro
' Macro recorded 4/1/2004 by Leslie
'
Dim tablecount As Integer
    If ActiveDocument.Tables.Count <> 0 Then
      tablecount = ActiveDocument.Tables.Count
    Else
      tablecount = 0
    End If
    tablecount = tablecount + 1
    
    With ActiveDocument
        .Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
            7, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
            wdAutoFitFixed
        With .Tables(tablecount)
            .Columns.PreferredWidthType = wdPreferredWidthPoints
            .Columns(1).PreferredWidth = InchesToPoints(0.7)
            .Columns(2).PreferredWidth = InchesToPoints(1.88)
            .Columns(3).PreferredWidth = InchesToPoints(0.63)
            .Columns(4).PreferredWidth = InchesToPoints(2.13)
            .Columns(5).PreferredWidth = InchesToPoints(0.5)
            .Columns(6).PreferredWidth = InchesToPoints(1.75)
            .Columns(7).PreferredWidth = InchesToPoints(0.5)
        End With
    End With
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
End Sub

Happy Fiday
;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[lespaul]

Thanks I'll give this a try later today!

Leslie


Leslie

 

[lespaul]

Ok, that seems to be working better than what I had, but now I need to add a little something.

I want to pass in a string from Delphi, so I've changed the macro to:

Sub MakeTable(strInfoList As String)
'
' MakeTable Macro
' Macro recorded 4/1/2004 by Leslie
'

Dim tablecount As Integer
    If ActiveDocument.Tables.Count <> 0 Then
      tablecount = ActiveDocument.Tables.Count
    Else
      tablecount = 0
    End If
    tablecount = tablecount + 1

    
    With ActiveDocument
        .Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
            7, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
            wdAutoFitFixed
        With .Tables(tablecount)
            .Columns.PreferredWidthType = wdPreferredWidthPoints
            .Columns(1).PreferredWidth = InchesToPoints(0.7)
            .Columns(2).PreferredWidth = InchesToPoints(1.88)
            .Columns(3).PreferredWidth = InchesToPoints(0.63)
            .Columns(4).PreferredWidth = InchesToPoints(2.13)
            .Columns(5).PreferredWidth = InchesToPoints(0.5)
            .Columns(6).PreferredWidth = InchesToPoints(1.75)
            .Columns(7).PreferredWidth = InchesToPoints(0.5)
        End With
    End With
'if it's the first table or the first table on a page then add the following in the cells and remove the border:

Cell 1:  Familiar?  
           Y/N	
Cell 2: If yes, how?	
Cell 3: Support
           1-5
Cell 4: Issues
Cell 5: Yard
        Sign
Cell 6: Notes/Email/Phone
Cell 7: Hm?

'enter strInfoList here

    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
End Sub

So I'll end up with

Familiar If yes, how? Support Issues Yard
Y/N 1-5 Sign

Ms. SALLY SMITH 123-4567 123 Main Street
And then an empty table
Mr. JOE BLOW 456-9871 321 S. Main Street
Another empty table

So here's what I'm doing in Delphi:

With qryGetAll do
begin
  SQL.CLear;
  SQL.Add('SELECT FNAME, MNAME, LNAME, SUFFIX, GENDER, ' +
  'STNUM, STPREDIR, STNAME, STSUF, STPSTDIR, STAPTT, STAPT, CITY, STATE, ' +
  'ZIP5, DOB, PHONE ' +
  'FROM CD1_DEMS WHERE PRECINCT = ' + QuotedStr(sPrecinct) + ' ORDER BY LNAME, FNAME');
  Active := True;
  If not isempty then
  begin
    WordApp := CreateOleObject('Word.Application');
    WordApp.Visible := True;
    while not eof do
    begin
      if FieldByName('PHONE').AsString <> '' then
      begin
        WordDoc := WordApp.Documents.Add('C:\PhoneList.dot');
        if FieldByName('GENDER').AsString = 'F' then
          strListInfo := 'Ms. ' + UpperCase(FieldByName('NAME').AsString) + UpperCase(FieldByName('LNAME').asString)
        else 
          strListInfo := 'Mr. ' + UpperCase(FieldByName('NAME').AsString) + UpperCase(FieldByName('LNAME').asString);
        WordApp.Run('MakeTable(strListInfo)');
      end;
    Next;
  end;
end;

So any help on the code will be greatly appreciated!

thanks,

leslie

 

[PHV]

Are you sure you want to create a PhoneList for each phone found ?

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[lespaul]

Thanks for pointing that out! No, that's not what I want to do, I'll need to move that.

leslie