主题：紧急求助：word报表引用子表数据的排序问题

狐表现在启用了word报表功能很好，但是在引用子表数据时，引用子表的 数据不能按照自己的要求排序。比如子表录入的记录（就是行数据）顺序为：记录1、记录2、记录3，在引用这三条记录时，我要求引用的顺序是：记录2、记录1、记录3。但我测试这样的要求不能实现，那位请指点应该如何处理？

能不能按照规定要求排序，并取值，这样才更有利于工作

正是需要word报表，还需要子表数据的自定义排序，请狐爸考虑增加这一功能

那位再有什么新的办法吗，请赐教

如何修改

'操控Word文档,主要是文档合并

'*******************************

'*********以下代码可修改**********

Dim FileName = "任免审批表.doc"   '定义模版文件名

Dim Ctn As String = "干部信息"  '当前表表名,通用格式Functions.Execute("CurrentTableName")

Dim Tb As Table = Tables(Ctn)   '定义当前表,通用.

 

'*********以上代码可修改**********

'*******************************

 

on error resume Next

If FileSys.DirectoryExists(ProjectPath & "Reports\") = False Then   '如果Reports文件夹不存在

    FileSys.CreateDirectory(ProjectPath & "Reports\")    '创建Reports文件夹

End If

Dim App As New MSWord.Application    '定义MSWord

 

'获得模版

FileSys.CopyFile(ProjectPath & "Attachments\" & FileName, ProjectPath & "Reports\" & FileName,True)

Dim nDoc = App.Documents.Open(ProjectPath & "Reports\" & FileName)

Dim rng As MSWord.Range = App.Documents(FileName).Range

rng.Select()   '全选

rng.Copy()   '拷贝

nDoc.Activate()

 

'插入文段

 

Dim cr As Row = Tb.Current    '定义当前行

 

'***********************************************

'*********以下是代码主体部分,需要修改**********

 

 

App.Selection.Find.ClearFormatting()

App.Selection.Find.Text = "[姓名]"

App.Selection.Find.Replacement.ClearFormatting()

App.Selection.Find.Replacement.Text = cr("姓名")

App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)

 

 

rng.Find.ClearFormatting()

If rng.Find.Execute("[照片]") Then

    rng.Select()

    If FileSys.FileExists(ProjectPath & "Attachments\照片\" & cr("照片")) Then

        App.Selection.InlineShapes.AddPicture(ProjectPath & "Attachments\照片\" & cr("照片"))

    End If

    rng = App.Documents(FileName).Range

    rng.Select()

End If

‘我是这样来处理的

 

Dim drs,drs1 As List(Of DataRow) drs = DataTables("社会关系").Select("[户主] = '" & cr("姓名") & "'","排序,出生年月")

 

For h As Integer = 0 To drs.Count-1

    App.Selection.Find.ClearFormatting()

    App.Selection.Find.Text = "[称谓" & h+1 & "]"

    App.Selection.Find.Replacement.ClearFormatting()

    App.Selection.Find.Replacement.Text = drs(h)("称谓")

    App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)

    App.Selection.Find.ClearFormatting()

    App.Selection.Find.Text = "[姓名" & h+1 & "]"

    App.Selection.Find.Replacement.ClearFormatting()

    App.Selection.Find.Replacement.Text = drs(h)("姓名")

    App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)

    App.Selection.Find.ClearFormatting()

    App.Selection.Find.Text = "[生日" & h+1 & "]"

    App.Selection.Find.Replacement.ClearFormatting()

    If drs(h).IsNull("出生年月") =False Then

        App.Selection.Find.Replacement.Text =  Format(drs(h)("出生年月"),"yyyy.MM")

    Else

        App.Selection.Find.Replacement.Text = ""

    End If

    App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)

    App.Selection.Find.ClearFormatting()

    App.Selection.Find.Text = "[政治" & h+1 & "]"

    App.Selection.Find.Replacement.ClearFormatting()

    App.Selection.Find.Replacement.Text = drs(h)("政治面貌")

    App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)

    App.Selection.Find.ClearFormatting()

    App.Selection.Find.Text = "[单位" & h+1 & "]"

    App.Selection.Find.Replacement.ClearFormatting()

    App.Selection.Find.Replacement.Text = drs(h)("工作单位及职务")

    App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)

    'If h = 6 Then

    'Exit For

    'End If

Next

If Tb.Rows.Count > 0 Then

    Dim Book As New XLS.Book(ProjectPath & "Attachments\Word任免审批表数据源.xls")

    Dim fl As String = ProjectPath & "Reports\Word任免审批表数据源.xls"

    Book.Build() '生成细节区

    Book.Save(fl) '保存工作簿

End If

 

'以下代码通过邮件合并方式合并简历,主要是因为有些人的简历超过255字

nDoc.Activate()

nDoc.MailMerge.OpenDataSource(Name:= ProjectPath & "Reports\Word任免审批表数据源.xls",SQLStatement:="SELECT * FROM `干部信息$`")   '链接数据源

App.Documents.Open(ProjectPath & "Reports\" & FileName)   '再次打开Word模版

nDoc.MailMerge.Execute()

nDoc.Close(False)

'以上代码主要用于合成简历

以上是我处理的办法，请大家指点，主要是红色代码部分

rng.Find.ClearFormatting()

If rng.Find.Execute("[照片]") Then

    rng.Select()

    If FileSys.FileExists(ProjectPath & "Attachments\照片\" & cr("照片")) Then

        App.Selection.InlineShapes.AddPicture(ProjectPath & "Attachments\照片\" & cr("照片"))

    End If

    rng = App.Documents(FileName).Range

    rng.Select()

End If

这里照片的大小如何控制，请赐教