79791169

Date: 2025-10-15 12:39:46
Score: 2.5
Natty:
Report link

I managed to fix the code, although my first solution did not work in the full example. The code below seems to work however. The reason my I added the Selection.MoveDown at the end of the macro is that I wanted the selection to be below the table just to make sure that I don't create another table inside the first table. There are probably much better ways to do this, also I want to avoid creating a table while the cursor is for example within a heading.

The problem with the em dash was actually related to me using Chr(151) on the Windows system originally, instead of the ChrW(8212). The latter works on the Mac as well.

Thanks

Sub Data_Object_Description()
'
' Macro Data_Object_Description
' Create a Microsoft Word table with a CANopen compliant object description
'
'
    Dim cmbCategory As ContentControl
    Dim cmbObjectCode As ContentControl
    Dim cmbDataType As ContentControl
    Dim rng As Range
    
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=4, NumColumns:= _
        4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
    With Selection.Tables(1)
'        If .Style <> "Table Grid" Then
'            .Style = "Table Grid"
'        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False

        .Range.ParagraphFormat.KeepWithNext = True
        .Range.ParagraphFormat.KeepTogether = True
        .Range.ParagraphFormat.SpaceBefore = 3
        .Range.ParagraphFormat.SpaceAfter = 3
        .Range.Font.Name = "Arial"
        .Range.Font.Size = 8
    
        .PreferredWidthType = wdPreferredWidthPoints
        .PreferredWidth = MillimetersToPoints(160)

        .Cell(1, 1).Merge MergeTo:=.Cell(2, 1)
        .Cell(3, 1).Merge MergeTo:=.Cell(4, 1)
        .Cell(1, 1).Shading.BackgroundPatternColor = RGB(128, 128, 128)
        .Cell(1, 2).Shading.BackgroundPatternColor = RGB(128, 128, 128)
        .Cell(2, 2).Shading.BackgroundPatternColor = RGB(128, 128, 128)
        .Cell(2, 3).Shading.BackgroundPatternColor = RGB(128, 128, 128)
        .Cell(2, 4).Shading.BackgroundPatternColor = RGB(128, 128, 128)

        Selection.Move Unit:=wdColumn, Count:=-1
        Selection.SelectColumn
        Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
        Selection.Columns.PreferredWidth = MillimetersToPoints(20)
        Selection.Move Unit:=wdColumn, Count:=1
        Selection.SelectColumn
        Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
        Selection.Columns.PreferredWidth = MillimetersToPoints(32)
        Selection.Move Unit:=wdColumn, Count:=1
        Selection.SelectColumn
        Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
        Selection.Columns.PreferredWidth = MillimetersToPoints(32)
        Selection.Move Unit:=wdColumn, Count:=1
        Selection.SelectColumn
        Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
        Selection.Columns.PreferredWidth = MillimetersToPoints(76)

        .Cell(1, 1).Select
        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Selection.Font.Bold = True
        Selection.Font.TextColor = vbWhite
        Selection.TypeText Text:="Index"

        ...

        .Cell(3, 2).Merge MergeTo:=.Cell(3, 4)

        Set rng = .Cell(4, 2).Range
        Set cmbCategory = rng.ContentControls.Add(wdContentControlComboBox)
        cmbCategory.Range.Text = "Select category"
        cmbCategory.SetPlaceholderText Text:=cmbCategory.Range.Text
        With cmbCategory
            .Title = "Category"
            .Tag = "Category"
            .DropdownListEntries.Clear
            .DropdownListEntries.Add Text:="mandatory", Value:="mandatory"
            .DropdownListEntries.Add Text:="optional", Value:="optional"
            .DropdownListEntries.Add Text:="conditional", Value:="conditional"
        End With
        Set rng = Nothing

        ...

    End With
    Set rng = Selection.Tables(1).Range
    rng.InsertCaption Label:="Table", Title:=" " + ChrW(8212) + " Object description", Position:=wdCaptionPositionAbove, ExcludeLabel:=0
    ActiveDocument.Range(rng.Start + Len("Table"), rng.Start + Len("Table") + 1).Text = ChrW(160)
    Set rng = Nothing

    Selection.MoveDown Count:=3
    Selection.TypeParagraph

End Sub
Reasons:
  • Blacklisted phrase (0.5): Thanks
  • Blacklisted phrase (1): did not work
  • RegEx Blacklisted phrase (1): I want
  • Long answer (-1):
  • Has code block (-0.5):
  • Self-answer (0.5):
  • Low reputation (1):
Posted by: Martin Merkel