WORD报表插入表格和生成的图表吗？ - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

Foxtable(狐表) → 用户栏目 → 专家坐堂 → WORD报表插入表格和生成的图表吗？

共有5016人关注过本帖树形打印复制链接主题：WORD报表插入表格和生成的图表吗？

大红袍

小大 31楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：贵宾帖子：39310 积分：196782 威望：0 精华：1 注册：2015/4/25 9:23:00

Post By：2015/11/3 15:01:00 [只看该作者]

Dim app As New MSWord.Application
Dim eApp As New MSExcel.Application
try
    Dim doc = app.Documents.Open("d:\test.doc")
    If app.ActiveWindow.Selection.Find.Execute("test") Then
        '插入表格,方法1或2

        Dim Wb As MSExcel.WorkBook = eApp.WorkBooks.Open("d:\test.xls")
        Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) '指定要复制的工作表
        For i As Integer = 7 To 12
            With Ws.UsedRange.Borders(i)
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = 2
            End With
        Next
        Ws.UsedRange.Font.Size = 12
        Ws.UsedRange.Copy

        app.ActiveWindow.Selection.paste
        app.Visible = True

    End If
catch ex As exception
    msgbox(ex.message)
    app.quit
finally
    eApp.quit
End try

一笑

小大 32楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：四尾狐帖子：808 积分：6213 威望：0 精华：0 注册：2014/3/23 23:02:00

Post By：2015/11/4 11:27:00 [只看该作者]

谢谢老师引路，自己有看看VBA，增加些格式设置。对画边框代码不理解，替换成了 Rg4.Borders.Linestyle = MSExcel.XlLineStyle.xlContinuous '边框线型，

Wb.Save保存了文件，我想删除该文件，代码该如何（帮助里没有），谢谢

'For i As Integer = 7 To 12

'With Ws.UsedRange.Borders(i)

'.ColorIndex = 0

'.TintAndShade = 0

'.Weight = 2

'End With

'Next

Ws.UsedRange.Font.Size = 15

Ws.UsedRange.Font.Name = "仿宋"

Ws.UsedRange.EntireColumn.AutoFit

Ws.UsedRange.EntireRow.AutoFit

Dim Rg4 As MSExcel.Range = Ws.UsedRange

Rg4.Borders.Linestyle = MSExcel.XlLineStyle.xlContinuous '边框线型

Rg4.Borders.ColorIndex = 3

Wb.Save

Ws.UsedRange.Copy

大红袍

小大 33楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：贵宾帖子：39310 积分：196782 威望：0 精华：1 注册：2015/4/25 9:23:00

Post By：2015/11/4 11:31:00 [只看该作者]

eApp.quit

If FileSys.FileExists("c:\data\fox2.jpg") Then '如果指定的文件存在
FileSys.DeleteFile("c:\data\fox2.jpg",2,2) '则彻底删除之
End If

一笑

小大 34楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：四尾狐帖子：808 积分：6213 威望：0 精华：0 注册：2014/3/23 23:02:00

Post By：2015/11/4 14:03:00 [只看该作者]

加上后，报错，说是已经在EXCEL中已打开，

另外，没次都弹出对话框，人工选择否，能否用代码选择否？

求解，谢谢

[此贴子已经被作者于2015/11/4 14:06:04编辑过]

大红袍

小大 35楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：贵宾帖子：39310 积分：196782 威望：0 精华：1 注册：2015/4/25 9:23:00

Post By：2015/11/4 14:58:00 [只看该作者]

wb.Saved = True

eApp.quit

If FileSys.FileExists("c:\data\fox2.jpg") Then '如果指定的文件存在
FileSys.DeleteFile("c:\data\fox2.jpg",2,2) '则彻底删除之
End If

------------------

不行，就贴出你写的完整代码。

一笑

小大 36楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：四尾狐帖子：808 积分：6213 威望：0 精华：0 注册：2014/3/23 23:02:00

Post By：2015/11/4 15:09:00 [只看该作者]

不好意思，第二条忘了贴图，如下：

此主题相关图片如下：剪贴板.jpg

代码如下：

Dim app As New MSWord.Application

Dim eApp As New MSExcel.Application

try

Dim doc = app.Documents.Open(ProjectPath & "\Reports\公司月报.docx")

If app.ActiveWindow.Selection.Find.Execute("test") Then

'插入表格,方法1或2

Dim Wb As MSExcel.WorkBook = eApp.WorkBooks.Open(ProjectPath & "事件.xls")

Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) '指定要复制的工作表

Ws.UsedRange.Font.Size = 15

Ws.UsedRange.Font.Name = "仿宋"

Dim Rg4 As MSExcel.Range = Ws.UsedRange

Rg4.Borders.Linestyle = MSExcel.XlLineStyle.xlContinuous '边框线型

Wb.Save

Ws.UsedRange.Copy

app.ActiveWindow.Selection.paste

app.Visible = True

End If

catch ex As exception

msgbox(ex.message)

app.quit

finally

eApp.quit

If FileSys.FileExists(ProjectPath & "事件.xls") Then '如果指定的文件存在

'FileSys.DeleteFile(ProjectPath & "事件.xls",2,2) '则彻底删除之

End If

End try

大红袍

小大 37楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：贵宾帖子：39310 积分：196782 威望：0 精华：1 注册：2015/4/25 9:23:00

Post By：2015/11/4 15:18:00 [只看该作者]

Dim app As New MSWord.Application
Dim eApp As New MSExcel.Application
try
    Dim doc = app.Documents.Open("d:\test.doc")
    If app.ActiveWindow.Selection.Find.Execute("test") Then
        '插入表格,方法1或2
        Dim Wb As MSExcel.WorkBook = eApp.WorkBooks.Open("d:\test.xls")
        Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) '指定要复制的工作表
        app.DisplayAlerts = False
        eapp.DisplayAlerts = False

        Ws.UsedRange.Font.Size = 15
        Ws.UsedRange.Font.Name = "仿宋"
        Dim Rg4 As MSExcel.Range = Ws.UsedRange
        Rg4.Borders.Linestyle = MSExcel.XlLineStyle.xlContinuous '边框线型
        Wb.Save
        Ws.UsedRange.Copy
        wb.saved = True
        app.ActiveWindow.Selection.paste
        eApp.quit

        app.Visible = True
    End If
catch ex As exception
    msgbox(ex.message)
    app.quit
finally
    eApp.quit
    system.Threading.Thread.sleep(1000)
    If FileSys.FileExists("d:\test.xls") Then '如果指定的文件存在
        FileSys.DeleteFile("d:\test.xls",2,2) '则彻底删除之
    End If
End try

一笑

小大 38楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：四尾狐帖子：808 积分：6213 威望：0 精华：0 注册：2014/3/23 23:02:00

Post By：2015/11/24 9:56:00 [只看该作者]

生成报表的代码单独运行也正确：

Dim n As Integer

n = Tables("月事件率").FindRow("选择 = True")'从第一行开始查找

If n >= 0 Then '如果找到的话

Dim Chart As New ChartBuilder '定义一个图表变量

Dim Series As WinForm.ChartSeries '定义一个图系变量

Dim t As Table = Tables("月事件率") '定义一个变量t引用数据表

Chart.SeriesList.Clear() '清除图表原来的图系

Series = Chart.SeriesList.Add() '增加一个图系

t.Sort = "年,月"

Series.Length = 12 '图系的数据点数等于表的行数

Series.Text = "G450"

Series.LineThickNess = 3

Series.DataLabelText = "{#YVAL}%"

For r As Integer = 0 To 11 '指定每个数据点的位置

Dim i As Integer = n-11+r

Series.X(r) = r

Series.Y(r) = t.Rows(i)("G450")* 100 '指定垂直坐标

Chart.AxisX.AnnoWithLabels = True '启用字符标示

Chart.SaveImage( ProjectPath & "G450.wmf")

Dim tm As String = ProjectPath & "Attachments\公司月报.docx" '指定模板文件

Dim fl As String = ProjectPath & "Reports\公司月报.docx" '指定目标文件

Dim wrt As New WordReport(Tables("月事件率"),tm,fl) '定义一个WordReport

wrt.ReplaceWithImage("[G450/550]",ProjectPath & "G450.wmf",450,300)

wrt.Build()

wrt.quit() '显示报表

end if

一笑

小大 39楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：四尾狐帖子：808 积分：6213 威望：0 精华：0 注册：2014/3/23 23:02:00

Post By：2015/11/24 9:57:00 [只看该作者]

以下代码单独运行时工作正常（生成一个统计表，保存，然后复制粘贴到指定的WORD文档（前面已生成的“公司月报”报表）的位置）：

Dim b As New SQLGroupTableBuilder("统计表1","事件汇总")

b.C

b.Groups.AddDef("事件名称") '分组

b.Totals.AddDef("次数",AggregateEnum.sum, "发生次数")'对数量进行统计

b.Subtotal = True

b.Build '生成统计表

Dim flg As New SaveExcelFlags

flg.RowNumber = True

Dim t1 As Table = Tables("统计表1")

Dim nn As String = "事件"

Dim fl1 As String = ProjectPath & "事件.xls"

t1.SaveExcel(fl1, nn, flg)

Dim app As New MSWord.Application

Dim eApp As New MSExcel.Application

try

Dim doc = app.Documents.Open(ProjectPath & "\Reports\公司月报.docx")

If app.ActiveWindow.Selection.Find.Execute("test") Then

'插入表格,方法1或2

Dim Wb As MSExcel.WorkBook = eApp.WorkBooks.Open(ProjectPath & "事件.xls")

Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) '指定要复制的工作表

app.DisplayAlerts = False

eapp.DisplayAlerts = False

Ws.UsedRange.EntireColumn.AutoFit

Ws.UsedRange.EntireRow.AutoFit

Dim Rg4 As MSExcel.Range = Ws.UsedRange

Rg4.Borders.Linestyle = MSExcel.XlLineStyle.xlContinuous '边框线型

'Wb.Save

Ws.UsedRange.Copy

'wb.saved = True

app.ActiveWindow.Selection.paste

eApp.quit

app.Visible = True

End If

catch ex As exception

msgbox(ex.message)

app.quit

finally

eApp.quit

End try

但是把2者组合起来就报错，粘贴复制的EXCEL表出问题，如下：

此主题相关图片如下：粘贴报错.jpg

求解，谢谢

请有空看看呗

[此贴子已经被作者于2015/11/26 9:14:26编辑过]

一笑

小大 40楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：四尾狐帖子：808 积分：6213 威望：0 精华：0 注册：2014/3/23 23:02:00

Post By：2015/11/26 15:10:00 [只看该作者]

请版主有空看看呗

下一主题 >> << 上一主题

总数 41 上一页 1 2 3 4 5 下一页

主题：WORD报表插入表格和生成的图表吗？