Word VBA: add textboxs in table cells?

tinfanide · #1 02-03-2012, 05:23 AM

Code:

Sub test()

Dim tbl As Word.Table

With ActiveDocument

    Set tbl = .Tables.Add(Range:=Selection.Range, _
    NumRows:=2, _
    NumColumns:=2, _
    DefaultTableBehavior:=wdWord8TableBehavior)

    With tbl
        
        .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
        .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
        .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
        .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
        .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
        

    End With


End With

End Sub

Is it possible to add textboxs inside table cells?

macropod · #2 02-03-2012, 02:55 PM

Hi tinfanide,

Yes. Try:

Code:

Sub Demo()
Dim lLeft As Long
With ActiveDocument
  lLeft = .Tables(1).Cell(2, 2).Range.Information(wdHorizontalPositionRelativeToPage)
  .Shapes.AddTextbox Orientation:=msoTextOrientationHorizontal, Left:=lLeft, _
    Top:=6, Width:=72, Height:=12, Anchor:=.Tables(1).Cell(2, 2).Range.Characters.First
End With
End Sub

tinfanide · #3 02-05-2012, 08:24 AM

Thank you very much.
You guys are always very helpful when I could barely find any reference on Word VBA.

tinfanide · #4 02-06-2012, 01:41 AM

Code:

Sub test()

Dim File As String
File = "C:\Users\Tin\Desktop\Testing.docx"

Dim oWord As Word.Application
Set oWord = New Word.Application
Dim oDoc As Word.Document
Set oDoc = oWord.Documents.Open(File)
oWord.Visible = True
oDoc.Activate


Dim lLeft As Long
Dim tbl As Word.Table

With oDoc

    Set tbl = .Tables.Add(Range:=.Range, _
        NumRows:=2, _
        NumColumns:=2, _
        DefaultTableBehavior:=wdWord8TableBehavior)
     
        With tbl
             
            .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
            .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
            .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
            .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
            .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
            .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
             
     
        End With

 lLeft = tbl.Cell(2, 2).Range.Information(wdHorizontalPositionRelativeToPage)
  .Shapes.AddTextbox Orientation:=msoTextOrientationHorizontal, Left:=lLeft, _
    Top:=6, Width:=72, Height:=12, Anchor:=tbl.Cell(2, 2).Range.Characters.First


End With

End Sub

I have automated adding textboxes of Word in Excel VBA.
It seems to have put the textbox on the top left of the document. It does not put within the table cell.

macropod · #5 02-06-2012, 02:27 AM

Hi tinfanide,

It seems Word needs som extra instruction about the location. Try something based on:

Code:

Sub Demo()
Dim Shp As Shape, Rng As Range
With ActiveDocument
    Set Rng = .Tables(1).Cell(2, 2).Range
    Rng.Collapse wdCollapseStart
    Set Shp = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
      Left:=0, Top:=0, Width:=72, Height:=12, Anchor:=Rng)
  With Shp
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
  End With
End With
End Sub

tinfanide · #6 02-06-2012, 04:28 AM

Code:

Sub TypeTextTypeUnderline()
 
Dim File As String
File = "C:\Users\Tin\Desktop\a.docx"
 
Dim oWord As Word.Application
Set oWord = New Word.Application
Dim oDoc As Word.Document
Set oDoc = oWord.Documents.Open(File)
oWord.Visible = True
oDoc.Activate
 
Dim tbl As Word.Table
Dim Shp As Shape, Rng As Range
With ActiveDocument
 
    Set tbl = .Tables.Add(Range:=.Range, _
    NumRows:=2, _
    NumColumns:=2, _
    DefaultTableBehavior:=wdWord8TableBehavior)
 
    With tbl
         
        .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
        .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
        .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
        .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
        .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
         
 
    End With

''' Runtime Error 13
''' Error: Type Mismatch
    Set Rng = .Tables(1).Cell(2, 2).Range
''' It seems Table.Cell.Range cannot be set to Range

    Rng.Collapse wdCollapseStart
    
    Set Shp = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
    Left:=0, Top:=0, Width:=72, Height:=12, Anchor:=Rng)
    
    With Shp
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
        .RelaitveVerticalPosition = wdRelativeVerticalPositionPage
    End With
 
 
End With
 
End Sub

I type the VBA codes in Excel.
It shows error in Word (please see the comments above within the codes).

macropod · #7 02-06-2012, 05:22 AM

Hi tinfanide,

Since you're automating Word from Excel, you need to change 'ActiveDocument' to 'oDoc'. You should also use:
Dim Tbl As Word.Table, Shp As Word.Shape, Rng As Word.Range
and you don't need:
oDoc.Activate
You've also mis-typed some of the code I gave you.

tinfanide · #8 02-06-2012, 06:07 AM

Code:

Sub TypeTextTypeUnderline()
 
Dim File As String
File = "C:\Users\Tin\Desktop\a.docx"
 
Dim oWord As Word.Application
Set oWord = New Word.Application
Dim oDoc As Word.Document
Set oDoc = oWord.Documents.Open(File)
oWord.Visible = True
 
Dim tbl As Word.Table

With oDoc
 
    Set tbl = .Tables.Add(Range:=.Range, _
    NumRows:=2, _
    NumColumns:=2, _
    DefaultTableBehavior:=wdWord8TableBehavior)
 
    With tbl
        .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
        .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
        .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
        .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
        .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
    End With
 
 
End With

Dim Shp As Word.Shape
Dim Rng As Word.Range
With oDoc
Set Rng = .Tables(1).Cell(2, 2).Range
    Rng.Collapse wdCollapseStart
    Set Shp = oDoc.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
      Left:=0, Top:=0, Width:=72, Height:=12, Anchor:=Rng)
  With Shp
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
  End With
End With
 
End Sub

Sorry, even though it was changed as ya said, but I still could not figure out why the textbox stays at the right top left of the page.

macropod · #9 02-06-2012, 03:14 PM

Hi tinfanide,

The following works for me:

Code:

Sub TypeTextTypeUnderline()
Dim File As String
File = "C:\Users\Tin\Desktop\a.docx"
Dim oWord As Word.Application
Set oWord = New Word.Application
Dim oDoc As Word.Document
Set oDoc = oWord.Documents.Open(File)
oWord.Visible = True
Dim tbl As Word.Table
Dim Shp As Word.Shape
Dim Rng As Word.Range
With oDoc
  Set tbl = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=2, _
    DefaultTableBehavior:=wdWord8TableBehavior)
  With tbl
    .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
    .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
    .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
    .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
    .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
    Set Rng = .Cell(2, 2).Range
    Rng.Collapse wdCollapseStart
  End With
  Set Shp = oDoc.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
    Left:=0, Top:=0, Width:=72, Height:=12, Anchor:=Rng)
  With Shp
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
  End With
End With
End Sub

tinfanide · #10 02-07-2012, 06:34 AM

Quote:

Originally Posted by macropod

Hi tinfanide,

The following works for me:

Code:

Sub TypeTextTypeUnderline()
Dim File As String
File = "C:\Users\Tin\Desktop\a.docx"
Dim oWord As Word.Application
Set oWord = New Word.Application
Dim oDoc As Word.Document
Set oDoc = oWord.Documents.Open(File)
oWord.Visible = True
Dim tbl As Word.Table
Dim Shp As Word.Shape
Dim Rng As Word.Range
With oDoc
  Set tbl = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=2, _
    DefaultTableBehavior:=wdWord8TableBehavior)
  With tbl
    .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
    .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
    .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
    .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
    .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
    Set Rng = .Cell(2, 2).Range
    Rng.Collapse wdCollapseStart
  End With
  Set Shp = oDoc.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
    Left:=0, Top:=0, Width:=72, Height:=12, Anchor:=Rng)
  With Shp
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
  End With
End With
End Sub

Following the codes by copy and paste, I could still not get the result wanted. Please take a look at how it fails to work.

Eventually I fixed it in a way that I didn't think was the best solution.

What I have expected is still get the textbox positioned relative to the targetted table cell.

http://www.youtube.com/watch?v=Hgv-LsQ9tTE&hd=1

macropod · #11 02-07-2012, 03:06 PM

Hi tinfanide,

Attached is a workbook containing the code, and an output document generated by it. I've restructured the code slightly, but that makes no difference to the outcome. As you can see, the textbox is correctly placed in cell B2 in the Word table.

Since I don't have your 'a' document, I replaced that bit of 'open' code in the Excel workbook with the 'add' method to create a new document.

tinfanide · #12 02-08-2012, 04:10 AM

Quote:

Originally Posted by macropod

Hi tinfanide,

Attached is a workbook containing the code, and an output document generated by it. I've restructured the code slightly, but that makes no difference to the outcome. As you can see, the textbox is correctly placed in cell B2 in the Word table.

Since I don't have your 'a' document, I replaced that bit of 'open' code in the Excel workbook with the 'add' method to create a new document.

Yes, it was strange. It works in your document but when I pasted your codes in a.xlsm, it didn't work.
Please see the attached a.xlsm and a.docx. Many thanks for your patience.

macropod · #13 02-09-2012, 12:05 AM

Hi tinfanide,

It seems something's changed about the way Word 2010 implements this. Try:

Code:

Sub TypeTextTypeUnderline()
Dim File As String, oWord As Word.Application, oDoc As Word.Document
Dim tbl As Word.Table, Shp As Word.Shape, Rng As Word.Range
Dim SngLeft As Single, SngTop As Single
File = "C:\Users\Tin\Desktop\a.docx"
Set oWord = New Word.Application
oWord.Visible = True
Set oDoc = oWord.Documents.Open(File)
With oDoc
  Set tbl = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=2, _
    DefaultTableBehavior:=wdWord8TableBehavior)
  With tbl
    .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
    .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
    .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
    .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
    .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
    Set Rng = .Cell(2, 2).Range
    Rng.Collapse wdCollapseStart
    SngLeft = Rng.Information(wdHorizontalPositionRelativeToPage)
    SngTop = Rng.Information(wdVerticalPositionRelativeToPage)
  End With
  Set Shp = oDoc.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
    Left:=SngLeft, Top:=SngTop, Width:=72, Height:=12, Anchor:=Rng)
  With Shp
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
  End With
End With
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
put a border around table cells that have text in them	tonywatsonmail	Mail Merge	1	01-31-2012 04:37 AM
Unwanted tabs in table cells	deltaskye	Word	5	01-27-2012 11:58 AM
Combining Text from Table Cells	robmorleyuk	Word	1	11-01-2011 07:24 AM
Copy table cell formatting across multiple cells / tables	pakistanray	Word Tables	2	10-31-2011 08:07 AM
Share your tips for centering images in table cells	WaltR	Word	4	01-29-2011 11:22 PM