none
Help with Selection, Range and inserting text RRS feed

  • Question

  • The following code works perfectly, but need some help expanding on it. Where I am inserting values into a particular cell, I needs to also insert text below in the same cell in a different font and size. Basically there is the Barcode version, and on a new line below it a human readable version in Times New Roman font, size 12.

    But I'm getting my Range and Selection turned around. Any help would be greatly appreciated. Code follows, Word 2010.

    Dim iTotal As Integer
    Dim wTable As Table
    Dim iCell As Integer
    Dim iRow As Integer
    Dim iLength As Integer
    Dim sAppend As String
    Const r As Integer = 5 'Static column count

    iRow = 1 'Ordinal values begin with 1
    iCell = 1 'Ordinal values begin with 1

    'Validation
    If Not IsNumeric(txtFrom.Value) Or Not IsNumeric(txtTo.Value) Then End
    If txtTo.Value < txtFrom.Value Then End

    Set wTable = ActiveDocument.Tables(1)

    For iTotal = txtFrom.Value To txtTo.Value
       
        sAppend = "" 'Reset string back to zero length
       
        'Build filler string
        For iLength = Len(CStr(iTotal)) To 6
            sAppend = sAppend & "0"
        Next iLength
       
        If iRow > wTable.Rows.Count Then wTable.Rows.Add 'Add a new row if we've reached the last and have more to go
        wTable.Rows(iRow).Cells(iCell).Range.Font.Name = "Code39HalfInchTT-Regular"
        wTable.Rows(iRow).Cells(iCell).Range.Font.Size = 28
        wTable.Rows(iRow).Cells(iCell).Range.Text = "*" & txtPrefix.Value & "-" & sAppend & iTotal & "*"
      
        iCell = iCell + 2 'Skip every other cell
       
        If iCell > r Then 'Start new row
            iRow = iRow + 1
            iCell = 1 'Reset cell count back to 1
        End If
       
    Next iTotal

    Unload Me

    Tuesday, July 24, 2012 5:28 PM

Answers

  • It's not entirely clear what you're trying to do, but try:



    Cheers
    Paul Edstein
    [MS MVP - Word]

    Actually, I just needed to be quite explicit about what I wanted to do, and then it worked. Here is a snippet of what I did, the relevant portion at least.

    'Set font, size and insert text
        wTable.Rows(iRow).Cells(iCell).Range.Font.Name = sBarcodeFont
        wTable.Rows(iRow).Cells(iCell).Range.Font.Size = iBarcodeFontSize
        wTable.Rows(iRow).Cells(iCell).Range.Text = "*" & txtPrefix.Value & "-" & sAppend & iTotal & "*"
       
    'Insert paragraph, text and set font and size
        wTable.Rows(iRow).Cells(iCell).Range.InsertParagraphAfter
        wTable.Rows(iRow).Cells(iCell).Range.InsertAfter txtPrefix.Value & "-" & sAppend & iTotal
        wTable.Rows(iRow).Cells(iCell).Range.Paragraphs(2).Range.Font.Name = sReadableFont
        wTable.Rows(iRow).Cells(iCell).Range.Paragraphs(2).Range.Font.Size = iReadableFontSize


    • Marked as answer by ITMn0403 Wednesday, July 25, 2012 2:11 PM
    Wednesday, July 25, 2012 1:56 PM

All replies

  • It's not entirely clear what you're trying to do, but try:

    Dim iTotal As Long, iCell As Long, iRow As Long, iLength As Long
    Dim wTable As Table, sAppend As String
    Const r As Long = 5 'Static column count
    iRow = 1: iCell = 1
    'Validation
    If Not IsNumeric(txtFrom.Value) Or Not IsNumeric(txtTo.Value) Then Exit Sub
    If txtTo.Value < txtFrom.Value Then Exit Sub
    Set wTable = ActiveDocument.Tables(1)
    For iTotal = txtFrom.Value To txtTo.Value
      sAppend = "" 'Reset string back to zero length
      'Build filler string
      For iLength = iTotal To 6
        sAppend = sAppend & "0"
      Next iLength
      With wTable
        If iRow > .Rows.Count Then .Rows.Add 'Add a new row if we've reached the last and have more to go
          With .Rows(iRow).Cells(iCell).Range
            .Font.Name = "Code39HalfInchTT-Regular"
            .Font.Size = 28
            .Text = "*" & txtPrefix.Value & "-" & sAppend & iTotal & "*"
          End With
          With .Rows(iRow + 1).Cells(iCell).Range
            .Font.Name = "Arial"
            .Font.Size = 12
            .Text = "*" & txtPrefix.Value & "-" & sAppend & iTotal & "*"
          End With
          iCell = iCell + 2 'Skip every other cell
          If iCell > r Then 'Start new row
             iRow = iRow + 2
             iCell = 1 'Reset cell count back to 1
          End If
        End With
    Next iTotal
    Unload Me


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, July 25, 2012 6:31 AM
  • It's not entirely clear what you're trying to do, but try:



    Cheers
    Paul Edstein
    [MS MVP - Word]

    Actually, I just needed to be quite explicit about what I wanted to do, and then it worked. Here is a snippet of what I did, the relevant portion at least.

    'Set font, size and insert text
        wTable.Rows(iRow).Cells(iCell).Range.Font.Name = sBarcodeFont
        wTable.Rows(iRow).Cells(iCell).Range.Font.Size = iBarcodeFontSize
        wTable.Rows(iRow).Cells(iCell).Range.Text = "*" & txtPrefix.Value & "-" & sAppend & iTotal & "*"
       
    'Insert paragraph, text and set font and size
        wTable.Rows(iRow).Cells(iCell).Range.InsertParagraphAfter
        wTable.Rows(iRow).Cells(iCell).Range.InsertAfter txtPrefix.Value & "-" & sAppend & iTotal
        wTable.Rows(iRow).Cells(iCell).Range.Paragraphs(2).Range.Font.Name = sReadableFont
        wTable.Rows(iRow).Cells(iCell).Range.Paragraphs(2).Range.Font.Size = iReadableFontSize


    • Marked as answer by ITMn0403 Wednesday, July 25, 2012 2:11 PM
    Wednesday, July 25, 2012 1:56 PM
  • All your calls to 'wTable.Rows(iRow).Cells(iCell).Range' make for inefficient code. If you check the code in my post, you'll see how to make it more efficient.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, July 25, 2012 1:59 PM
  • All your calls to 'wTable.Rows(iRow).Cells(iCell).Range' make for inefficient code. If you check the code in my post, you'll see how to make it more efficient.

    Cheers
    Paul Edstein
    [MS MVP - Word]


    Yes, I'm well aware of the With...End With directive. Thank you.
    Wednesday, July 25, 2012 2:11 PM