drop-out the table items using the vba in word

Zhibek · #1 08-09-2018, 11:41 PM

Where in this macros I need change the line or add new function that list items must be different in each case?

Because now it copies list items from first table(employee)

Code:

Option Explicit
Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
Dim oTable As Table
Dim oRng As Range
Dim occ As ContentControl
Dim i As Integer
    'Spouse
    Select Case ContentControl.Title
        Case "Spouse"
            Set oRng = ContentControl.Range.Tables(1).Range
            For i = 1 To ActiveDocument.Tables.Count
                If oRng.InRange(ActiveDocument.Tables(i).Range) Then
                    Exit For
                End If
            Next i
            If ContentControl.Checked = True Then
                MsgBox "Âûáðàòü ñóïðóãà(-ó)"
                If Not ActiveDocument.Tables(i + 1).Rows.Count > 1 Then
                    Set oRng = ActiveDocument.Tables(i).Range
                    oRng.Collapse 0
                    oRng.Text = vbCr
                    oRng.Collapse 0
                    oRng.FormattedText = ActiveDocument.Tables(2).Range.FormattedText
                End If
            Else
                MsgBox "Óäàëèòü ñóïðóãà(-ó)"
                Set oTable = ActiveDocument.Tables(i + 1)
                If oTable.Rows.Count > 1 Then
                    For Each occ In oTable.Range.ContentControls
                        occ.LockContentControl = False
                    Next occ
                    Set oRng = oTable.Range
                    oRng.Start = oRng.Start - 1
                    oRng.End = oRng.Paragraphs(1).Range.End
                    oTable.Delete
                    oRng.Delete
                End If
            End If
            Selection.HomeKey wdStory
'Child 1
        Case "Child1"
            Set oRng = ContentControl.Range.Tables(1).Range
            For i = 1 To ActiveDocument.Tables.Count
                If oRng.InRange(ActiveDocument.Tables(i).Range) Then
                    Exit For
                End If
            Next i
            If ContentControl.Checked = True Then
                MsgBox "Adding child section"
                If oRng.InRange(ActiveDocument.Tables(ActiveDocument.Tables.Count).Range) Then
                    Set oRng = ActiveDocument.Tables(i).Range
                    oRng.Collapse 0
                    oRng.Text = vbCr
                    oRng.Collapse 0
                    oRng.FormattedText = ActiveDocument.Tables(2).Range.FormattedText
                End If
            Else
                If Not oRng.InRange(ActiveDocument.Tables(ActiveDocument.Tables.Count).Range) Then
                    MsgBox "Removing child section"
                    Set oTable = ActiveDocument.Tables(i + 1)
                    If oTable.Rows.Count > 1 Then
                        For Each occ In oTable.Range.ContentControls
                            occ.LockContentControl = False
                        Next occ
                        Set oRng = oTable.Range
                        oRng.Start = oRng.Start - 1
                        oRng.End = oRng.Paragraphs(1).Range.End
                        oTable.Delete
                        oRng.Delete
                    End If
                End If
            End If
            Selection.HomeKey wdStory
'Child 2
Case "Child2"
            Set oRng = ContentControl.Range.Tables(1).Range
            For i = 1 To ActiveDocument.Tables.Count
                If oRng.InRange(ActiveDocument.Tables(i).Range) Then
                    Exit For
                End If
            Next i
            If ContentControl.Checked = True Then
                MsgBox "Adding child section"
                If oRng.InRange(ActiveDocument.Tables(ActiveDocument.Tables.Count).Range) Then
                    Set oRng = ActiveDocument.Tables(i).Range
                    oRng.Collapse 0
                    oRng.Text = vbCr
                    oRng.Collapse 0
                    oRng.FormattedText = ActiveDocument.Tables(2).Range.FormattedText
                End If
            Else
                If Not oRng.InRange(ActiveDocument.Tables(ActiveDocument.Tables.Count).Range) Then
                    MsgBox "Removing child section"
                    Set oTable = ActiveDocument.Tables(i + 1)
                    If oTable.Rows.Count > 1 Then
                        For Each occ In oTable.Range.ContentControls
                            occ.LockContentControl = False
                        Next occ
                        Set oRng = oTable.Range
                        oRng.Start = oRng.Start - 1
                        oRng.End = oRng.Paragraphs(1).Range.End
                        oTable.Delete
                        oRng.Delete
                    End If
                End If
            End If
            Selection.HomeKey wdStory
'Child 3
Case "Child1"
            Set oRng = ContentControl.Range.Tables(1).Range
            For i = 1 To ActiveDocument.Tables.Count
                If oRng.InRange(ActiveDocument.Tables(i).Range) Then
                    Exit For
                End If
            Next i
            If ContentControl.Checked = True Then
                MsgBox "Adding child section"
                If oRng.InRange(ActiveDocument.Tables(ActiveDocument.Tables.Count).Range) Then
                    Set oRng = ActiveDocument.Tables(i).Range
                    oRng.Collapse 0
                    oRng.Text = vbCr
                    oRng.Collapse 0
                    oRng.FormattedText = ActiveDocument.Tables(2).Range.FormattedText
                End If
            Else
                If Not oRng.InRange(ActiveDocument.Tables(ActiveDocument.Tables.Count).Range) Then
                    MsgBox "Removing child section"
                    Set oTable = ActiveDocument.Tables(i + 1)
                    If oTable.Rows.Count > 1 Then
                        For Each occ In oTable.Range.ContentControls
                            occ.LockContentControl = False
                        Next occ
                        Set oRng = oTable.Range
                        oRng.Start = oRng.Start - 1
                        oRng.End = oRng.Paragraphs(1).Range.End
                        oTable.Delete
                        oRng.Delete
                    End If
                End If
            End If
            Selection.HomeKey wdStory
'Child 4
Case "Child1"
            Set oRng = ContentControl.Range.Tables(1).Range
            For i = 1 To ActiveDocument.Tables.Count
                If oRng.InRange(ActiveDocument.Tables(i).Range) Then
                    Exit For
                End If
            Next i
            If ContentControl.Checked = True Then
                MsgBox "Adding child section"
                If oRng.InRange(ActiveDocument.Tables(ActiveDocument.Tables.Count).Range) Then
                    Set oRng = ActiveDocument.Tables(i).Range
                    oRng.Collapse 0
                    oRng.Text = vbCr
                    oRng.Collapse 0
                    oRng.FormattedText = ActiveDocument.Tables(2).Range.FormattedText
                End If
            Else
                If Not oRng.InRange(ActiveDocument.Tables(ActiveDocument.Tables.Count).Range) Then
                    MsgBox "Removing child section"
                    Set oTable = ActiveDocument.Tables(i + 1)
                    If oTable.Rows.Count > 1 Then
                        For Each occ In oTable.Range.ContentControls
                            occ.LockContentControl = False
                        Next occ
                        Set oRng = oTable.Range
                        oRng.Start = oRng.Start - 1
                        oRng.End = oRng.Paragraphs(1).Range.End
                        oTable.Delete
                        oRng.Delete
                    End If
                End If
            End If
            Selection.HomeKey wdStory
    End Select
End Sub

Also, that message which appears in MsgBox I need it in Russian language,
but I changed it to Russian letters and finally in MsgBox shows smth not readable,

What should I do?)

Thank you!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Counting items in the table	digiart	Word VBA	1	08-25-2017 10:17 PM
Lock items in a table	village	Word	2	06-22-2017 07:33 AM
Select multiple items from a drop down list	ConfuddledOne	Excel Programming	0	01-30-2017 08:13 PM
How can I style individual items of a drop down or combobox?	supremegrandruler	Word	1	12-09-2014 03:17 PM
Drag and Drop Outlook Items to Word	Mike23	Outlook	0	06-14-2010 03:51 PM