[求助]编的代码有点问题，估计出在插入图片的语句，请守柔老师帮忙看看

duke008

dH6KMYbZ.rar (81.17 KB, 下载次数: 37)

2005-12-6 17:43 上传

点击文件名下载附件
[求助]编的代码有点问题，估计出在插入图片的语句，请守柔老师帮忙看看

Sub page1()
Dim m, nrecord, txtnumber As Integer
Dim i As Bookmark
Set md = DBEngine.OpenDatabase("F:\study\db1.mdb")
Set rs = md.OpenRecordset("car")
Set mydoc1 = ActiveDocument
Selection.WholeStory
Selection.Copy
Set mydoc2 = Documents.Add
Selection.Paste
On Error Resume Next
rs.MoveLast
nrecord = rs.RecordCount
On Error GoTo doerror
doerror:
For m = 1 To nrecord
If m = 1 Then rs.MoveFirst Else rs.MoveNext
With rs
mydoc2.Bookmarks("chead").Select
With Selection.Font
.Bold = wdToggle
.NameAscii = "宋体"
.NameFarEast = "宋体"
.NameBi = "宋体"
.Size = 10
.SizeBi = 10
.Underline = 0
.Color = wdColorBlack
End With
Selection.TypeText Text:=.Fields("chead")

mydoc2.Bookmarks("ehead").Select
With Selection.Font
.Name = "Arial"
.Size = 10
End With
Selection.TypeText Text:=.Fields("ehead")

mydoc2.Bookmarks("pub").Select
With Selection.Font
.Bold = wdToggle
.NameAscii = "宋体"
.NameFarEast = "宋体"
.NameBi = "宋体"
.Size = 10
.SizeBi = 10
.Underline = 0
.Color = wdColorBlack
End With
Selection.TypeText Text:=.Fields("cpub") & Chr(32) & Chr(32) & .Fields

("date") & Chr(32) & Chr(32) & .Fields("page")

mydoc2.Bookmarks("cir").Select
With Selection.Font
.Bold = wdToggle
.Name = "Arial"
.Size = 10
End With
If .Fields("net") = False Then
Selection.TypeText Text:=.Fields("cir") & Chr(32) & Chr(32) & .Fields

("loc")
Else
Selection.TypeText Text:="N/A"
End If

mydoc2.Bookmarks("size").Select
With Selection.Font
.Bold = wdToggle
.Name = "Arial"
.Size = 10
End With
If .Fields("net") = False Then
Selection.TypeText Text:=.Fields("size")
Else
Selection.TypeText Text:="N/A"
End If

mydoc2.Bookmarks("author").Select
With Selection.Font
.Bold = wdToggle
.Name = "Arial"
.Size = 10
End With
Selection.TypeText Text:=.Fields("author")

mydoc2.Bookmarks("cs").Select
With Selection.Font
.NameAscii = "宋体"
.NameFarEast = "宋体"
.NameBi = "宋体"
.Size = 10
.SizeBi = 10
.Underline = 0
.Color = wdColorBlack
End With
Selection.TypeText Text:=.Fields("csummary")

mydoc2.Bookmarks("es").Select
With Selection.Font
.Name = "Arial"
.Size = 10
End With
Selection.TypeText Text:=.Fields("esummary") & Chr(13) & Chr(13)

mydoc2.Bookmarks("text").Select
With Selection.Font
.NameAscii = "宋体"
.NameFarEast = "宋体"
.NameBi = "宋体"
.Size = 10
.SizeBi = 10
.Underline = 0
.Color = wdColorBlack
End With
Selection.TypeText Text:=.Fields("text")
End With

For Each i In ActiveDocument.Bookmarks
i.Delete
Next
If m < nrecord Then
Selection.InsertBreak Type:=wdPageBreak
mydoc1.Activate
Selection.Copy
mydoc2.Activate
Selection.Paste
End If
Next m
End Sub

这是我写的一个从access读取数据到word的代码，上面的是可以运行的，但是我将黑体部分改为下面的代码，就不能通过，提示“next 没有 for”，指向倒数第二行的“next m”。

mydoc2.Bookmarks("text").Select
If .Fields("net") = True Then
With Selection.Font
.NameAscii = "宋体"
.NameFarEast = "宋体"
.NameBi = "宋体"
.Size = 10
.SizeBi = 10
.Underline = 0
.Color = wdColorBlack
End With
Selection.TypeText Text:=.Fields("text")
Else
Selection.InlineShapes.AddPicture FileName:=.Fields("text"), LinkToFile:=False, SaveWithDocument:=True
End If

那段插入图片的代码是我用录制宏得到的，问题是不是出在这里呢？

duke008

我又想了一下，数据库的text字段还是得改成ole，因为文章的内容有可能是全文字，也有可能是1张图片，还有可能是好几张图片或是文字和图片结合。

不过还是想知道上面的代码问题出在哪里，至于对ole的操作，我先找找相关资料，能自己做就自己做，不行的话可能又要麻烦版主或各位大侠了。

duke008

我现在把text字段设置为ole，输入的时候不管是全文字还是图文结合都做成word文档存到text字段，现在的问题是如何从word将其读出。我暂时还没找到相关资料，望守柔老师指点。

守柔

以下代码供参考，如果你想在TEXT字段有文字又有图片路径时，请固定图片路径，比如始终在最后的30个字符位置，可修改一下判断语句的代码。

Option Explicit
Sub page1()
'VBE/工具/引用:Microsoft DAO 3.6 Object Library
Dim Md As DAO.Database, Rs As DAO.Recordset, myPicPath As String
Dim myDoc As Document, myRange As Range, EndRange As Range
On Error Resume Next
Application.ScreenUpdating = False
Set myDoc = ActiveDocument
Set Md = DBEngine.OpenDatabase("E:\DOWNLOADS\Excelhome\db1.mdb") '此处修改数据库路径名
Set Rs = Md.OpenRecordset("car")
With myDoc
Do While Not Rs.EOF
Set EndRange = .Range(.Content.End - 1, .Content.End - 1)
.AttachedTemplate.AutoTextEntries("SGM").Insert EndRange, True
EndRange.SetRange EndRange.Start, .Content.End - 1
Set myRange = EndRange.Paragraphs(2).Range
myRange.SetRange myRange.End - 1, myRange.End - 1
myRange.InsertAfter Rs.Fields("chead")
With myRange.Font
.Bold = False
.Name = "宋体"
.Size = 10
.Underline = 0
.Color = wdColorBlack
End With
myRange.SetRange myRange.End, myRange.End
myRange.InsertAfter " / " & Rs.Fields("ehead")
With myRange.Font
.Name = "Arial"
.Size = 10
End With
myRange.SetRange EndRange.Paragraphs(3).Range.End - 1, EndRange.Paragraphs(3).Range.End - 1
myRange.InsertAfter Rs.Fields("cpub") & " " & Rs.Fields("date") & " " & Rs.Fields("page") & " 　　 "
With myRange.Font
.Bold = False
.Name = "宋体"
.Size = 10
.Underline = 0
.Color = wdColorBlack
End With
myRange.SetRange EndRange.Paragraphs(4).Range.End - 1, EndRange.Paragraphs(4).Range.End - 1
If Rs.Fields("net") = False Then
myRange.InsertAfter Rs.Fields("cir") & " " & Rs.Fields("loc")
Else
myRange.InsertAfter "N/A"
End If
With myRange.Font
.Bold = False
.Name = "Arial"
.Size = 10
End With
myRange.SetRange EndRange.Paragraphs(5).Range.End - 1, EndRange.Paragraphs(5).Range.End - 1
If Rs.Fields("net") = False Then
myRange.InsertAfter Rs.Fields("size")
Else
myRange.InsertAfter "N/A"
End If
With myRange.Font
.Bold = False
.Name = "Arial"
.Size = 10
End With
myRange.SetRange EndRange.Paragraphs(6).Range.End - 1, EndRange.Paragraphs(6).Range.End - 1
myRange.InsertAfter Rs.Fields("author")
With myRange.Font
.Bold = False
.Name = "Arial"
.Size = 10
End With
Set EndRange = .Range(.Content.End - 1, .Content.End - 1)
EndRange.InsertAfter Rs.Fields("csummary")
With EndRange.Font
.Bold = False
.Name = "宋体"
.Size = 10
.Underline = 0
.Color = wdColorBlack
End With
Set EndRange = .Range(.Content.End - 1, .Content.End - 1)
EndRange.InsertAfter Chr(13) & Rs.Fields("esummary") & Chr(13) & Chr(13)
With EndRange.Font
.Name = "Arial"
.Size = 10
End With
Set EndRange = .Range(.Content.End - 1, .Content.End - 1)
myPicPath = Rs.Fields("text")
If Len(myPicPath) > 30 Then
EndRange.InsertAfter Chr(13) & myPicPath
ElseIf Dir(myPicPath, vbDirectory) <> "" Then
EndRange.InsertAfter Chr(13)
EndRange.SetRange EndRange.End, EndRange.End
.InlineShapes.AddPicture FileName:=myPicPath, Range:=EndRange
End If
With EndRange.Font
.Bold = False
.Name = "宋体"
.Size = 10
.Underline = 0
.Color = wdColorBlack
End With
.Content.InsertAfter Chr(13) & Chr(12)
Rs.MoveNext
Loop
.Paragraphs.Last.Range.Delete
End With
Md.Close
Set Md = Nothing
Set Rs = Nothing
Application.ScreenUpdating = False
End Sub
""""""""""""""""""""""""""""""""""""""""""""""""""""

操作方法，双击该模板，便可以此模板新建一个文档，单击常用工具栏第一个命令“读取ACCESS数据库”命令即可。

RRGHpvyF.rar (14.17 KB, 下载次数: 70)

2005-12-8 06:07 上传

点击文件名下载附件
[求助]编的代码有点问题，估计出在插入图片的语句，请守柔老师帮忙看看

lgcmeli

十分不错呢。