Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #8  
Old 07-17-2020, 10:14 AM
gmaxey gmaxey is offline Finding Tables with Vertically Merged Cells Windows 10 Finding Tables with Vertically Merged Cells Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,636
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

Andrew\T-Belle


Changing the view to Normal and combining a couple of processes will come even closer. There is still a problem is the last row has VMCs and that could be due to the Err_Handler to get passed the earlier error presented.


Code:
Sub ProcTbls()
Dim oTbl As Table, oNT As Table
Dim lngView As Long
  lngView = ActiveDocument.ActiveWindow.View
  ActiveDocument.ActiveWindow.View = wdNormalView
  Application.ScreenUpdating = False
  For Each oTbl In ActiveDocument.Tables
    SplitVMCs oTbl
    MarkNonUniformity oTbl
    For Each oNT In oTbl.Tables
      SplitVMCs oNT
      MarkNonUniformity oNT
    Next oNT
  Next oTbl
  ActiveDocument.ActiveWindow.View = lngView
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub

Sub SplitVMCs(oTbl As Table)
Dim oCell As Cell, oRng As Range
Dim lngRow As Long, lngSplit As Long
  If Not oTbl.Uniform Then
    For Each oCell In oTbl.Range.Cells
    If oCell.RowIndex = oTbl.Rows.Count Then Exit For
      Set oRng = oCell.Range
      oRng.Select
      Selection.MoveDown Unit:=wdLine, Count:=1
      On Error GoTo Err_Cell
      If Selection.Information(wdWithInTable) Then
        lngSplit = Selection.Cells(1).RowIndex - oRng.Cells(1).RowIndex
      Else
        lngSplit = oTbl.Rows.Count - oRng.Cells(1).RowIndex + 1
      End If
Err_RE:
      If lngSplit > 1 Then oCell.Split NumRows:=lngSplit
    Next oCell
  End If
lbl_Exit:
  Exit Sub
Err_Cell:
  lngSplit = 1
  Resume Err_RE
End Sub
Sub MarkNonUniformity(oTbl As Table)
'A basic Word macro coded by Greg Maxey
Dim oRow As Row, oCol As Column
Dim bVM As Boolean, bHM As Boolean, bBoth As Boolean
  bVM = False: bHM = False: bBoth = False
  With oTbl
    If Not .Uniform Then
      On Error Resume Next
      Set oRow = .Rows(1)
      If Err.Number = 5991 Then bVM = True
      Err.Clear
      Set oCol = oTbl.Columns(1)
      If Err.Number = 5992 Then bHM = True
      If bVM And bHM Then bBoth = True
      Select Case True
        Case bBoth: .Range.Cells(1).Shading.BackgroundPatternColor = wdColorGreen
        Case bVM: .Range.Cells(1).Shading.BackgroundPatternColor = wdColorRose
        Case bHM: .Range.Cells(1).Shading.BackgroundPatternColor = wdColorPaleBlue
      End Select
    End If
  End With
lbl_Exit:
  Exit Sub
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
 

Tags
merged cells, tables



Similar Threads
Thread Thread Starter Forum Replies Last Post
Finding Tables with Vertically Merged Cells Format tables with vertically merged cells jeffreybrown Word VBA 2 01-16-2019 03:23 PM
Unmerging vertically merged cells kilroy Word VBA 5 01-12-2018 12:54 PM
VBA color of visible gridlines of tables word (with some merged cells in first rows) Alvaro.passi Word VBA 0 07-18-2017 09:11 AM
Finding Tables with Vertically Merged Cells Overcome issues in tables with vertically merged cells rocky2 Word VBA 12 12-22-2016 03:03 AM
Combining 2 tables into 1 and use Table2's column widths (hoping for workaround dealing merged cells CodingGuruInTraining Word VBA 24 10-07-2015 07:48 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 01:08 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft