这段程序看不懂,请高手帮忙!!!!!!!!!!!!! (200分)

  • 主题发起人 主题发起人 heqian
  • 开始时间 开始时间
H

heqian

Unregistered / Unconfirmed
GUEST, unregistred user!
Global WordApp As Word.Application
Global WordDoc As Word.Document

Option Explicit
Option Compare Text

Sub SetField(DocVarName As String, DocVarValue As String)

Dim i As Long
Dim CompareLength As Long
Dim CompareString As String

CompareString = " DOCVARIABLE """ & DocVarName & """"
CompareLength = Len(CompareString)

For i = 1 To WordDoc.Fields.count
If Left(WordDoc.Fields(i).Code, CompareLength) = CompareString Then
WordDoc.Fields(i).Result.Text = DocVarValue
End If

Next i

End Sub

Sub Add3(s1 As String, s2 As String, s3 As String, newstr As String)

If s1 = "" Then
s1 = newstr

ElseIf s2 = "" Then
s2 = newstr

ElseIf s3 = "" Then
s3 = newstr

End If

End Sub

Function Highlights() As String

Dim temp1 As String
Dim temp2 As String
Dim temp3 As String

If Range("B35").Value > 0 Then
Add3 temp1, temp2, temp3, " a clubhouse"

ElseIf Range("B33").Value > 0 Or Range("B34").Value > 0 Then
Add3 temp1, temp2, temp3, " a raised platform"

End If

If Range("B44").Value > 0 Then
Add3 temp1, temp2, temp3, " a tube slide"

ElseIf Range("B42").Value > 0 Or Range("B43").Value > 0 Then
Add3 temp1, temp2, temp3, " a slide"

End If

If Range("B39").Value > 0 Or Range("B40").Value > 0 Or Range("B41").Value > 0 Then
Add3 temp1, temp2, temp3, " a ladder bar"

End If

If Range("B28").Value > 0 Then
Add3 temp1, temp2, temp3, " a glider"

End If

If Range("B29").Value > 0 Then
Add3 temp1, temp2, temp3, " a tire swing"

End If

If Range("B30").Value > 0 Then
Add3 temp1, temp2, temp3, " a rope swing"

End If

If Range("B27").Value > 0 Then
Add3 temp1, temp2, temp3, " an infant swing"

End If

If Range("B26").Value = 1 Then
Add3 temp1, temp2, temp3, " a deluxe swing"

ElseIf Range("B26").Value = 2 Then
Add3 temp1, temp2, temp3, " two deluxe swings"

ElseIf Range("B26").Value = 3 Then
Add3 temp1, temp2, temp3, " three deluxe swings"

End If

If Range("B25").Value = 1 Then
Add3 temp1, temp2, temp3, " a standard swing"

ElseIf Range("B25").Value = 2 Then
Add3 temp1, temp2, temp3, " two standard swings"

ElseIf Range("B25").Value = 3 Then
Add3 temp1, temp2, temp3, " three standard swings"

End If

If temp2 = "" Then
Highlights = temp1

ElseIf temp3 = "" Then
Highlights = temp1 & " and" & temp2

Else
Highlights = temp1 & "," & temp2 & " and" & temp3

End If

End Function

Sub Basic2Swing()
'
' Basic2swing Macro
' Macro recorded 3/11/1999 by Wayne S. Freeze
'
'
Range("B25").Select
ActiveCell.FormulaR1C1 = "2"
Range("B31").Select
ActiveCell.FormulaR1C1 = "2"
Range("B36").Select
ActiveCell.FormulaR1C1 = "1"

End Sub
Sub ClearCells()
'
' ClearCells Macro
' Macro recorded 3/11/1999 by Wayne S. Freeze
'
'
Range("B25:B44").Select
Selection.ClearContents

End Sub

Sub VerifyProposal()

If Range("H49").Value <> 2 Then
MsgBox "You must select two supports for the swing set."

ElseIf Range("H53").Value <> 1 Then
MsgBox "You can only have one beam for the swing set."

ElseIf Range("H50").Value > 0 And Range("H51").Value = 0 Then
MsgBox "You must have a 4' platform for your 4' slide."

ElseIf Range("B42").Value > 0 And Range("B33").Value = 0 Then
MsgBox "You must have a 3' platform for your 3' slide."

ElseIf Range("H52").Value > 2 And Range("H54") = 1 Then
MsgBox "Only two swings are allowed on a five or six foot beam."

ElseIf Range("H52").Value > 3 And Range("H55") = 1 Then
MsgBox "Only three swings are allowed on an eight foot beam."

Else
MsgBox "The swingset is configured properly."

End If

End Sub

[red][red]Sub CreateProposal()

Dim i As Long

If WordApp Is Nothing Then
Set WordApp = New Word.Application
WordApp.Visible = True

End If

If Not (WordDoc Is Nothing) Then
WordDoc.Close False

End If

Set WordDoc = WordApp.Documents.Add("d:/norton/samswings.dot")

SetField "Name", Range("C6").Text
SetField "ShortName", Range("C7").Text
SetField "Street", Range("C8").Text
SetField "CityStateZip", Range("C9").Text
SetField "ContactDate", Range("C11").Text
SetField "Reason", Range("C12").Text
SetField "Highlights", Highlights()
SetField "TotalPrice", Range("H46").Text
SetField "TotalTime", Range("H47").Text
SetField "DeliveryTime", Range("H48").Text

End Sub[/red][/red]
Sub PrintProposal()

If Not (WordDoc Is Nothing) Then
WordDoc.PrintOut
WordDoc.Close False
ActiveWindow.SelectedSheets.PrintOut
WordApp.Quit

End If

End Sub
Sub Basic3Swing()
'
' Basic3Swing Macro
' Macro recorded 3/11/1999 by Wayne S. Freeze
'
'
Range("B25").Select
ActiveCell.FormulaR1C1 = "3"
Range("B31").Select
ActiveCell.FormulaR1C1 = "2"
Range("B38").Select
ActiveCell.FormulaR1C1 = "1"

End Sub
Sub Deluxe2Swing()
'
' Deluxe2Swing Macro
' Macro recorded 3/11/1999 by Wayne S. Freeze
'
'
Range("B26").Select
ActiveCell.FormulaR1C1 = "2"
Range("B31").Select
ActiveCell.FormulaR1C1 = "2"
Range("B39").Select
ActiveCell.FormulaR1C1 = "1"

End Sub

Sub Deluxe3Swing()
'
' Deluxe2Swing Macro
' Macro recorded 3/11/1999 by Wayne S. Freeze
'
'
Range("B26").Select
ActiveCell.FormulaR1C1 = "3"
Range("B31").Select
ActiveCell.FormulaR1C1 = "2"
Range("B41").Select
ActiveCell.FormulaR1C1 = "1"

End Sub
Sub Platform2Swing()
'
' Platform2Swing Macro
' Macro recorded 3/11/1999 by Wayne S. Freeze
'
'
Range("B25").Select
ActiveCell.FormulaR1C1 = "2"
Range("B31").Select
ActiveCell.FormulaR1C1 = "1"
Range("B34").Select
ActiveCell.FormulaR1C1 = "1"
Range("B37").Select
ActiveCell.FormulaR1C1 = "1"
Range("B43").Select
ActiveCell.FormulaR1C1 = "1"

End Sub
Sub Platform3Swing()
'
' Platform2Swing Macro
' Macro recorded 3/11/1999 by Wayne S. Freeze
'
'
Range("B25").Select
ActiveCell.FormulaR1C1 = "3"
Range("B31").Select
ActiveCell.FormulaR1C1 = "1"
Range("B34").Select
ActiveCell.FormulaR1C1 = "1"
Range("B38").Select
ActiveCell.FormulaR1C1 = "1"
Range("B43").Select
ActiveCell.FormulaR1C1 = "1"

End Sub

上面这段程序是在EXCEL中编写的宏,其中红色部分是将EXCEL中的部分字段内容插入
到以WORD模板新建的文档中的!!
现在我的问题有两个:
1、这段程序是如何定位插入内容在WORD文档中的位置的????????
2、我现在的工作是通过DELPHI调用WORD,将数据库中的一些数据插入到
WORD中,是否可以控制用户不能修改、删除从数据库中插入的内容,对其他
部分可以随便操作?????????
每个问题100分,如果觉得不够,可以再加!!!!!!!!!!!!!!
 
没有人帮助我么???????????
如果觉得分少,可以再加200分!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
帮你顶!
 
"d:/norton/samswings.dot"
已经定义好了域 名字就是 “ DOCVARIABLE "Name" ”
“ DOCVARIABLE "ShortName" ”
等等
程序通过检索域的名称来定位
Sub SetField(DocVarName As String, DocVarValue As String)

Dim i As Long
Dim CompareLength As Long
Dim CompareString As String

CompareString = " DOCVARIABLE """ & DocVarName & """"
CompareLength = Len(CompareString)

For i = 1 To WordDoc.Fields.count//对所有域进行检索
If Left(WordDoc.Fields(i).Code, CompareLength) = CompareString Then//比较是否域的名字是否一样。
WordDoc.Fields(i).Result.Text = DocVarValue//修改值
End If

Next i

End Sub


 
帮你顶!
 
可是如何控制插入的这些字符呀????????
 
晕了....[8D]
 
谢谢realLearning!!
第二个问题我也基本搞定了!!代码如下:
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1902976
我通过定义书签,将书签名称与内容保存到数据库中,然后在关闭WORD文档时
首先判断书签的数量与数据库中保存的数量是否一致,如果不一致,则说明书签被删除,
如果一致,则逐个判断各个书签的内容是否与数据库中的一致,如果不一致,则替换。
呵呵,文字描述的这部分还没有写代码,因该很简单吧!!等写出来在贴出来!!!!
 
WordApp.Visible:=false;
if WordApp.ActiveDocument.Content.Bookmarks.Count<BookMark_Count then
begin //判定如果文挡书签数量比数据库中书签数量少,则退出,进行提示
Application.MessageBox('工程设备信息被删除,无法将文件加入流程,请重新建立文挡!','',mb_ok);
Save_And_Close_ActiveDocument;
DeleteFile(GetCurrentDir+'/Doc_Temp.doc');
goto Clear_BookMark;
end
else begin //如果书签数量不少,则分别比较书签内容;
with adoquery_do do
begin
sql.Clear;
sql.Add('select * from xlgq_SCGL_LC_NeiRong_bookmark');
open;
end;
for i:=0 to adoquery_do.RecordCount-1 do
begin
bookmark_name:=adoquery_do.FieldValues['bookmark'];
bookmark_text:=trim(adoquery_do.FieldValues['text']);
if WordApp.ActiveDocument.Content.Bookmarks.Exists(Bookmark_name) then
begin //如果该书签名称存在,则恢复内容,否则退出
WordApp.ActiveDocument.Content.Bookmarks.Item(bookmark_name).Select;
Replace_string(WordApp.Selection.Range,WordApp.Selection.Text,BookMark_Text);//替换内容
end
else begin
Application.MessageBox('工程设备信息被删除,无法将文件加入流程,请重新建立文挡!','',mb_ok);
Save_And_Close_ActiveDocument;
DeleteFile(GetCurrentDir+'/Doc_Temp.doc');
Goto Clear_BookMark;
end;
Adoquery_do.Next;
end;
end;
 
我不是看不懂,你是的太長,我沒有時間看!改天幫你瞧瞧!
 
[red][h3]這是VB寫的的吧,好久沒用過VB語言了,真有點不懂,幫你頂一下吧。。。[:D][/h3][/red]
 
2、我现在的工作是通过DELPHI调用WORD,将数据库中的一些数据插入到
WORD中,是否可以控制用户不能修改、删除从数据库中插入的内容,对其他
部分可以随便操作?????????


這個比較困難吧
因為你保存好的word文檔誰不可以改?要是改不了,那word也沒有甚麼用了
 
把上面的VB代码复制到WORD的VB编辑器中然后执行。
看看WORD有什么变化就清楚了 。
 
没仔细看,但是VB代码没错!
我现在用VB在开发,我们用的报表就是用EXCEL做的,效果不错的。
我们的方法是在EXCEL中加入一个用VB编写的模块,打印时输出数据到一个TXT,宏调用一个相对位置的TXT,取得其中的数据给网络。目前唯一的不好就是没做分栏,但可嵌几个表。

以上让大家见笑了!
 
為何不把它轉成PDF檔呢?這樣別人想改都改不了了!
我現在和FASTREPORT直接轉過去,傳給客戶,效果不錯!
 
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1902976

问题基本解决了!
 
多人接受答案了。
 
后退
顶部