有合并单元格的表格，用vba 向右插入列发生突出现象，该怎么办？

大罡

代码入下：EX1为原来的表格，运行代码后，想变成ex2的结果，可是却成了Ex3的结果。

应该怎么修改代码，才能成为 EX3的结果？谢谢

Code:

Sub test()

     Dim p As Long

     Dim tb As Table

      Set tb = ActiveDocument.Tables(1)

        tb.Cell(1, 1).Select

       p = Selection.Information(wdMaximumNumberOfColumns)

       tb.Cell(1, p).Select

        Selection.InsertColumnsRight

End Sub

wdpfox

手动插入表格不是很方便吗？

We meet by chance like patches of drifting duckweed,  
May everything be fine with you everyday !
  （你我萍水相逢，愿君一切安好！）

大罡

如果有100个表格呢？

wdpfox

参考一下这个试试：https://www.it1352.com/1648042.html

We meet by chance like patches of drifting duckweed,  
May everything be fine with you everyday !
  （你我萍水相逢，愿君一切安好！）

大罡

I think out it， code is：
自己想出了，算是一种算法吧，但不是最好的。
Sub Atest()
Dim t As Table, r As Long, p As Long, cw As Single
Set t = ActiveDocument.Tables(1)
t.Cell(1, 1).Select                                     'select table fisrt cell
p = Selection.Information(wdMaximumNumberOfColumns)    'get current  column Count
t.Cell(1, p).Select                                     'select table fisrt rows,last cell
cw = t.Cell(1, p).Width                                ' first row,last cell width
q = Selection.Information(wdMaximumNumberOfRows)          ''get current row Count
For r = 1 To q
  t.Cell(r, 1).Select
  p = Selection.Information(wdMaximumNumberOfColumns)       ' some row include merge cell ,so every rows need get it column count
  t.Cell(r, p).Select
  Selection.Next(Unit:=wdWord, Count:=1).Select              'move cursor outside of every row's last cell
  Selection.InsertCells (0)                                   'so,at this time ,inert a cell of last cell right side,
  t.Cell(r, p + 1).SetWidth ColumnWidth:=cw, RulerStyle:=3     '0 means:wdInsertCellsShiftRight
Next r                                                         ' every insert cell set  a same column width
      

QQ214189912

1. Sub test()
   
2.     Dim p As Long
   
3.     Dim tb As Table
   
4.     Set tb = ActiveDocument.Tables(1)
   
5.     tb.Cell(1, 1).Select
   
6.     p = Selection.Information(wdMaximumNumberOfColumns)
   
7.     tb.Cell(1, p).Select
   
8.     Application.CommandBars.FindControl(ID:=3687).Execute
   
9. End Sub

复制代码

大罡

膜拜，这个很给力啊！

大罡

感谢QQ214189912，坚定了我继续学习vba的决心