Using Character Sets and Font Types

I have a table and want to insert in to a particular cell on a particular row a WingDing symbol (ticked box) followed by some text ("A First Submission").

I have used the following:

Code:

---

        .Rows(2).Cells(1).Range.Text = "Is this "
        .Rows(2).Cells(2).Range.InsertSymbol Font:="Wingdings", CharacterNumber:=-3842, Unicode:=True
        .Rows(2).Cells(2).Range.Text = "A First submission"
        .Rows(2).Cells(3).Range.Text = "An Extended First submission"
        .Rows(2).Cells(4).Range.Text = "A Resubmission"

---

I get an error every time I run this (or a variant of this) and so, how would I do this?

I got the above character number from a recorded macro but the Unicode value is being shown as 254 or 00FE. This makes no difference to the error but just in case someone raises this as an issue.

Full passage code is...

Code:

---

    oDoc.Range.InsertParagraphAfter
    Set oRng = oDoc.Range
    oRng.Collapse 0
   
    Set oTable4 = oDoc.Tables.Add(Range:=oRng, NumRows:=4, NumColumns:=1)
   
    With oTable4
       
        .Columns(1).PreferredWidth = CentimetersToPoints(16)
        .Rows(1).Shading.BackgroundPatternColor = RGB(192, 192, 192)
        .Columns(1).Cells(1).Range.Bold = True
        .Columns(1).Cells(1).Range.Text = "Submission Information"
        .Rows(1).Borders.OutsideLineStyle = wdLineStyleSingle
       
        .Rows(2).Cells(1).Split 1, 4
        .Rows(2).Cells(1).PreferredWidth = CentimetersToPoints(1.5)
        .Rows(2).Cells(2).PreferredWidth = CentimetersToPoints(4)
        .Rows(2).Cells(3).PreferredWidth = CentimetersToPoints(5)
        .Rows(2).Cells(4).PreferredWidth = CentimetersToPoints(4.5)
        .Rows(2).Cells(1).Range.Text = "Is this "
        .Rows(2).Cells(2).Range.InsertSymbol Font:="Wingdings", CharacterNumber:=-3842, Unicode:=True
        .Rows(2).Cells(2).Range.Text = "A First submission"
        .Rows(2).Cells(3).Range.Text = "An Extended First submission"
        .Rows(2).Cells(4).Range.Text = "A Resubmission"
       
        .Rows(4).Cells(1).Split 3, 2
       
        .Rows(4).Cells(1).Range.Text = "Was this work submitted by the agreed (or officially extended) deadline?"
        .Rows(5).Cells(1).Range.Text = "Does the work submitted reflect the assignment scenario?"
        .Rows(6).Cells(1).Range.Text = "Is the work submitted in the correct format as per the assignment brief?"
       
        .Borders.OutsideLineStyle = wdLineStyleSingle
       
    End With

---

The line generating the error is...

Code:

---

.Rows(2).Cells(2).Range.InsertSymbol Font:="Wingdings", CharacterNumber:=-3842, Unicode:=True

---

Don't use both Font.name and character number

Code:

---

With .Cells(2, 2)
.Font = "Wingdings2"
.Value = "R"
End With

---

Code:

---

.Cells(2, 2) = ChrW(254)

---

I think you have to back into it by selecting the cell, backing up one, inserting the Wingdings, and then TypeText since .Rows(2).Cells(2).Range.Text = "A First submission" will replace the cell contents anyway

Code:

---

Sub test2()
Dim oDoc As Document
Dim oTable4 As Table
Dim oRng As Range
Set oDoc = ActiveDocument
oDoc.Range.InsertParagraphAfter
Set oRng = oDoc.Range
oRng.Collapse 0
Set oTable4 = oDoc.Tables.Add(Range:=oRng, NumRows:=4, NumColumns:=1)
 
With oTable4
   
    .Columns(1).PreferredWidth = CentimetersToPoints(16)
    .Rows(1).Shading.BackgroundPatternColor = RGB(192, 192, 192)
    .Columns(1).Cells(1).Range.Bold = True
    .Columns(1).Cells(1).Range.Text = "Submission Information"
    .Rows(1).Borders.OutsideLineStyle = wdLineStyleSingle
   
    .Rows(2).Cells(1).Split 1, 4
    .Rows(2).Cells(1).PreferredWidth = CentimetersToPoints(1.5)
    .Rows(2).Cells(2).PreferredWidth = CentimetersToPoints(4)
    .Rows(2).Cells(3).PreferredWidth = CentimetersToPoints(5)
    .Rows(2).Cells(4).PreferredWidth = CentimetersToPoints(4.5)
    .Rows(2).Cells(1).Range.Text = "Is this "
    .Rows(2).Cells(2).Range.Select                                    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    Selection.InsertSymbol Font:="Wingdings", CharacterNumber:=-3842, Unicode:=True
    Selection.TypeText "A First submission"
    .Rows(2).Cells(3).Range.Text = "An Extended First submission"
    .Rows(2).Cells(4).Range.Text = "A Resubmission"
   
    .Rows(4).Cells(1).Split 3, 2
   
    .Rows(4).Cells(1).Range.Text = "Was this work submitted by the agreed (or officially extended) deadline?"
    .Rows(5).Cells(1).Range.Text = "Does the work submitted reflect the assignment scenario?"
    .Rows(6).Cells(1).Range.Text = "Is the work submitted in the correct format as per the assignment brief?"
   
    .Borders.OutsideLineStyle = wdLineStyleSingle
   
End With
End Sub

---

Thanks Paul, works perfectly. Thank you.

SamT, sorry but VBA in Word would not recognise any of the structure you provided.