excel如何删除word内表格的空行

罗亮亮

刚刚接触VBA  研究出来个这个计划提报工具  但是 word表格的空行始终找不到代码,希望大神师傅们给个指点 在中间加段打码让这个功能实现一下  感激 计表计划报送系统.zip (370.61 KB, 下载次数: 7)

2020-1-20 17:26 上传

点击文件名下载附件

   并非伸手党  也感谢 之前指点的师傅们
Sub 按钮1_Click()
    If [E1] = "" Then
    MsgBox "计划类型为空,请填好！"
    Exit Sub
    End If
    If [M1] = "" Then
    MsgBox "填报人为空,请填好！"
    Exit Sub
    End If
If MsgBox("真的已经核对好了吗？点是后数据会导出到文件根目录下，点否再给你一次检查的机会", vbYesNo, "提示信息") = vbNo Then
  Exit Sub
Else
'If MsgBox("是否确定要导出计划?这需要花费10秒左右", vbYesNo, "温馨提示") = vbYes Then
Dim moban As String, linshi As String
Dim wodapp As Word.Application
      StarTime = Timer '开始时间记录 '
Set wodapp = New Word.Application
moban = ThisWorkbook.Path & "\模板\表格模板.doc" '定义模板路径
'linshi = ThisWorkbook.Path & "\生成的计划表.doc"  '导出文件名
linshi = ThisWorkbook.Path & "\" & "计表计划" & "(" & Sheets("Sheet1").Cells(1, 5) & Sheets("Sheet1").Cells(1, 10) & ").doc"
FileCopy moban, linshi '将模版文件拷贝到一个临时文件
Dim filename As String                                       '定义文件路径
With wodapp
'filename = ThisWorkbook.Path & "\生成的计划表.doc"
filename = ThisWorkbook.Path & "\" & "计表计划" & "(" & Sheets("Sheet1").Cells(1, 5) & Sheets("Sheet1").Cells(1, 10) & ").doc"
'filename = ThisWorkbook.Path & "\" & "生成的计划表" & "(" & Sheets("Sheet1").Cells(1, 5) & ").doc"
wodapp.Application.Documents.Open filename:=filename           '打开文件
wodapp.Visible = False  'False/true
'                                        ↓输入到word的列数
' wodapp.ActiveDocument.Tables(1).Cell(2, 3).Range = Sheets("Sheet1").Cells(2, 3) '填写指定单元格表格数据
'                                   ↑输入到word的行数
For j = 4 To 20 '填写表格数据
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 1).Range = Sheets("Sheet1").Cells(j, 1)
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 2).Range = Sheets("Sheet1").Cells(j, 2)
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 3).Range = Sheets("Sheet1").Cells(j, 3)
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 4).Range = Sheets("Sheet1").Cells(j, 4)
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 5).Range = Sheets("Sheet1").Cells(j, 5)
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 6).Range = Sheets("Sheet1").Cells(j, 6)
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 7).Range = Sheets("Sheet1").Cells(j, 7)
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 8).Range = Sheets("Sheet1").Cells(j, 8)
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 9).Range = Sheets("Sheet1").Cells(j, 9)
           wodapp.ActiveDocument.Tables(1).Cell(j - 2, 10).Range = Sheets("Sheet1").Cells(j, 10)
          'wodapp.ActiveDocument.Tables(1).Cell(j + 2, 4).Range = Sheets("Sheet1").Cells(j + 2, 5)
Next j
           Str1 = "数据"
           Str2 = Sheets("Sheet1").Cells(1, 5)
           .Selection.HomeKey Unit:=wdStory '光标置于文件首
           If .Selection.Find.Execute(Str1) Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str2 '替换字符串
           End If
           Str1 = "数据"
           Str2 = Sheets("Sheet1").Cells(1, 5)
           .Selection.HomeKey Unit:=wdStory '光标置于文件首
           If .Selection.Find.Execute(Str1) Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str2 '替换字符串
           End If
            Str1 = "数据2"
           Str2 = Sheets("Sheet1").Cells(1, 13)
           .Selection.HomeKey Unit:=wdStory '光标置于文件首
           If .Selection.Find.Execute(Str1) Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str2 '替换字符串
           End If
           Str1 = "数据3"
           Str2 = Sheets("Sheet1").Cells(1, 14)
           .Selection.HomeKey Unit:=wdStory '光标置于文件首
           If .Selection.Find.Execute(Str1) Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str2 '替换字符串
           End If

'wodapp.PrintPreview = True '打印预览
wodapp.Documents.Save
wodapp.Quit
End With
'        [E1] = "": [M1] = ""
        EndTime = Timer '结束时间记录'
      MsgBox "供电车间计划批量导出数据已完成！文件在文件根目录下" & Chr(13) & Format(EndTime - StarTime, "程序运行时间约为：0.00秒"), 64, "提取结果" '提示所用时间'
      End If
End Sub

罗亮亮

哪位好心的师傅 帮帮忙呗

蓝桥玄霜

附件中没有表格模板.docx 文档

sirsunny

你可以试试这样，word模板只设置一行，再根据实际填报的内容增加行数。ActiveDocument.Application.Selection.InsertRowsBelow

罗亮亮

蓝桥玄霜 发表于 2020-1-21 09:37
附件中没有表格模板.docx 文档

计表计划报送系统.zip (364.43 KB, 下载次数: 8)

2020-1-21 20:00 上传

点击文件名下载附件

实在抱歉 是我的过失  已重新上传啦

魂断蓝桥

Application.ActiveDocument.Tables(1).Cell(1, 1).Select '光标定位表格第一行第一列
Selection.MoveDown Unit:=wdLine, Count:=2 '下移两行，定位到第三行
Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow '删除第三行

蓝桥玄霜

填表的代码：
模板中保留20行，其余行删除。保留行数可以自行修改。

罗亮亮

蓝桥玄霜 发表于 2020-1-22 09:38
填表的代码：
模板中保留20行，其余行删除。保留行数可以自行修改。

大牛呀 厉害厉害 经常看您帮助坛友  实在是佩服

罗亮亮

蓝桥玄霜 发表于 2020-1-22 09:38
填表的代码：
模板中保留20行，其余行删除。保留行数可以自行修改。

师傅,代码测试了 导出word里面有回车符 有没有办法帮忙优化下 实在不行我就只能在word里面录制删除回车符的宏