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

 或者是，你排序以后，循环每一行，给_Sortkey赋值为对应的数字

'操控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

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

 

你这样控制了还有什么问题？肯定能按照你的顺序替换的啊。

 

不要只上传代码，做个简单的例子发上来

具体代码如何写

 

无语，你不是写了么？你实在不会做，就请做一个简单的例子发上来

是控制了，但是软件做好了，要交付使用后其他人也可以根据需要制作报表，对不懂的人来说又做不到