如何将行添加到合并的Word表?

时间:2017-06-26 16:07:53

标签: excel vba excel-vba ms-word

这就是表格的样子。

enter image description here

代码:

alter session set nls_date_format='mm/dd/yyyy hh24:mi';

with
     avail_times ( start_time, end_time ) as (
       select to_date('06/20/2017 08:00'), to_date('06/20/2017 10:00') from dual union all
       select to_date('06/20/2017 12:00'), to_date('06/20/2017 14:00') from dual union all
       select to_date('06/20/2017 15:00'), to_date('06/20/2017 17:00') from dual
     )
select   trunc(min(start_time)) as start_time, min(start_time) as end_time
  from   avail_times
  where  trunc(start_time) = to_date(:input_date, 'mm/dd/yyyy')
union all
select   end_time, 
         lead(start_time, 1, trunc(start_time) + 1) over (order by start_time)
  from   avail_times
  where  trunc(end_time) = trunc(start_time)
order by start_time
;

START_TIME        END_TIME
----------------  ----------------
06/20/2017 00:00  06/20/2017 08:00
06/20/2017 10:00  06/20/2017 12:00
06/20/2017 14:00  06/20/2017 15:00
06/20/2017 17:00  06/21/2017 00:00

当我运行此操作时,收到错误消息:Sub WordTableTester() Dim CurrentTable As table Dim wdDoc As Document Dim Rw As Long, col As Long Dim wdFileName wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , "Please choose a file containing requirements to be imported") If wdFileName = False Then Exit Sub '(user cancelled import file browser) Set wdDoc = GetObject(wdFileName) 'open Word file With wdDoc Set CurrentTable = wdDoc.Tables(1) Rw = 9: col = CurrentTable.Columns.Count wdDoc.Range(CurrentTable.Cell(Rw, 1).Range.start, _ CurrentTable.Cell(Rw, col).Range.start).Select wdDoc.Application.Selection.InsertRowsBelow End With End Sub

注意:我正在运行VBA Excel宏并将行导入/添加到Word文档中的表

1 个答案:

答案 0 :(得分:3)

使用MS Word表中的合并行有点棘手。

这是你想要的吗?

Sub Sample()
    Dim CurrentTable As Table
    Dim wdDoc As Document
    Dim Rw As Long, col As Long

    Set wdDoc = ActiveDocument '<~~ Created this for testing
    Set CurrentTable = wdDoc.Tables(1)

    Rw = 9: col = CurrentTable.Columns.Count

    wdDoc.Range(CurrentTable.Cell(Rw, 1).Range.Start, _
    CurrentTable.Cell(Rw, col).Range.Start).Select

    wdDoc.Application.Selection.InsertRowsBelow
End Sub

<强>截图 enter image description here

修改

你桌子的格式全都搞砸了。表创建了几行,然后合并/拆分单元格以创建新行,因此您收到错误。此外,由于你是从excel自动化单词,我建议采用以下方式。

试试这个

Sub WordTableTester()
    Dim oWordApp As Object, oWordDoc As Object, CurrentTable As Object
    Dim flName As Variant
    Dim Rw As Long, col As Long

    flName = Application.GetOpenFilename("Word files (*.docx),*.docx", _
    , "Please choose a file containing requirements to be imported")

    If flName = False Then Exit Sub

    Set oWordApp = CreateObject("Word.Application")
    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(flName)
    Set CurrentTable = oWordDoc.Tables(1)

    Rw = 7: col = CurrentTable.Columns.Count

    oWordDoc.Range(CurrentTable.Cell(Rw, 1).Range.Start, _
    CurrentTable.Cell(Rw, col).Range.Start).Select

    oWordDoc.Application.Selection.InsertRowsBelow
End Sub