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分,如果觉得不够,可以再加!!!!!!!!!!!!!!
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分,如果觉得不够,可以再加!!!!!!!!!!!!!!