|
Доброго времени суток, Посетитель!
|
|
|
|
|
|
|
|
|
вид форума:
|
| |
|
|
| | Возникла необходимость лепить документы слияния в Worde из прог-мы на VB6. Как это делается в самом WORDe знаю, делала неоднократно. А как послать команду из проги с неким Recordsetом (формируемым интерактивно) в качестве параметра и получить на его основе документ слияния (или можно прежде сохранить нужный набор данных как запрос или таблицу? или не надо?) Может, кто-нибудь пробовал? Подскажите, пожалуйста!
Спасибо! | |
| |
| |
| |
|
|
| | а что такое
документы слияния в Worde | |
| |
| |
| |
|
|
| | Дрюня, здравствуйте!
Документы слияния - это письма, рассылка, как их иначе называют... Т.е. на основе шаблона, привязывая базу данных (mdb, dbf, лист Exel. таблицу Word) получаем многостраничный документ с полями из базы данных. Вот.
Но кое-что я уже нашла вот тут:
http://support.microsoft.com/kb/285332/ru
Но если есть готовенькие примеры, буду рада!
Спасибо! | |
| |
| |
| |
автор: Аноним (14.11.2006 в 10:23) |
|
| | например, так
Option Explicit
Private appWord As Word.Application
Private docWord As Document
Private objTable As Table
Private rngCurrent As Word.Range
Public Function rpt_Order(id As Long) As Boolean
Dim lng As Long, _
sFileName As String, _
rs As ADODB.Recordset, _
sSQL As String
On Error GoTo L_Err
Screen.MousePointer = vbHourglass
sFileName = App.Path & "\Templates\Order.dot"
Set rs = New ADODB.Recordset
sSQL = "SELECT tblOrder.*, tblCustomer.Name, tblOrderState.Name," _
& " [tblPersonnel].[Name] & IIf([FirstName]<>'',' ' & Left(([FirstName]),1) & '.','')" _
& " & IIf([PatronymicName]<>'',Left([PatronymicName],1) & '.','') AS FIO" _
& " FROM tblPersonnel INNER JOIN (tblOrderState INNER JOIN (tblOrder INNER JOIN" _
& " tblCustomer ON tblOrder.CustomerID = tblCustomer.CustomerID) ON" _
& " tblOrderState.OrderStateID = tblOrder.OrderStateID) ON tblPersonnel.PersonnelID" _
& " = tblOrder.PersonnelID" _
& " where OrderID=" & id
rs.Open sSQL, cnn
If rs.EOF Then MsgBox "Çàêàç íå íàéäåí â ÁÄ", vbExclamation, "rpt_Order": GoTo L_Exit
Set appWord = New Word.Application
appWord.Visible = True
Set docWord = appWord.Documents.Add(sFileName, False, wdNewBlankDocument, True)
docWord.SpellingChecked = False
'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Set objTable = docWord.Tables.Item(1)
With objTable
.Cell(2, 3).Range = IIf(IsNull(rs("DateOrder")), "", rs("DateOrder"))
.Cell(3, 3).Range = IIf(IsNull(rs("NumberOrder")), "", rs("NumberOrder"))
.Cell(4, 3).Range = IIf(IsNull(rs("OrderDescription")), "", rs("OrderDescription"))
.Cell(5, 3).Range = IIf(IsNull(rs("tblCustomer.Name")), "", rs("tblCustomer.Name"))
.Cell(6, 3).Range = IIf(IsNull(rs("CirculationProduction")), "", rs("CirculationProduction"))
.Cell(7, 3).Range = IIf(IsNull(rs("FIO")), "", rs("FIO"))
.Cell(8, 3).Range = IIf(IsNull(rs("tblOrderState.Name")), "", rs("tblOrderState.Name"))
End With
'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Call ord_Calculation(id)
L_Exit: Screen.MousePointer = vbDefault
Set rs = Nothing: Set appWord = Nothing
Set docWord = Nothing: Set objTable = Nothing
Exit Function
L_Err: MsgBox Err.Description & " (" & Err.Number & ")", vbExclamation, "rpt_Order": GoTo L_Exit
End Function
Private Sub ord_Calculation(id As Long)
Dim DiscountKoeff As Double, _
IncreaseKoeff As Double, _
cost_Design As Double, _
cost_PrintWork As Double, _
cost_PrintMaterial As Double, _
cost_PrintCutting As Double, _
cost_PostPrintWork As Double, _
cost_PostPrintMaterial As Double, _
cost_AdditionalWork As Double, _
cost_Pay As Double, _
cost_Total As Double, _
cost_Final As Double
Dim sSQL As String, _
rs As ADODB.Recordset
On Error GoTo L_Err
Set rs = New ADODB.Recordset
'êîýôôèöèåíòû ñêèäêè/íàäáàâêè, äèçàéí èç òàáëèöû "tblOrder"
sSQL = "select * from tblOrder where OrderID=" & id
rs.Open sSQL, cnn
If rs.EOF Then rs.Close: GoTo L_Exit
DiscountKoeff = IIf(IsNull(rs("CostDiscountKoeff")), 0#, rs("CostDiscountKoeff"))
objTable.Cell(21, 2).Range = Format(cost_Design, "###0.00")
IncreaseKoeff = IIf(IsNull(rs("CostIncreaseKoeff")), 0#, rs("CostIncreaseKoeff"))
objTable.Cell(22, 2).Range = Format(cost_Design, "###0.00")
cost_Design = IIf(IsNull(rs("CostDesign")), 0, rs("CostDesign"))
objTable.Cell(11, 4).Range = Format(cost_Design, "###0.00")
rs.Close
'ñòîèìîñòü ïå÷àòè èç òàáëèöû "tblOrderPrint"
sSQL = "SELECT tblOrderPrint.OrderID, Sum(tblOrderPrint.PriceMaterial)" _
& " AS SumOfPriceMaterial, Sum(tblOrderPrint.PricePrint) AS SumOfPricePrint," _
& " Sum(tblOrderPrint.PriceCutting) AS SumOfPriceCutting" _
& " From tblOrderPrint" _
& " Where OrderID = " & id _
& " GROUP BY tblOrderPrint.OrderID"
rs.Open sSQL, cnn
If Not rs.EOF Then
cost_PrintWork = IIf(IsNull(rs("SumOfPricePrint")), 0, rs("SumOfPricePrint"))
objTable.Cell(12, 4).Range = Format(cost_PrintWork, "###0.00")
cost_PrintMaterial = IIf(IsNull(rs("SumOfPriceMaterial")), 0, rs("SumOfPriceMaterial"))
objTable.Cell(13, 4).Range = Format(cost_PrintMaterial, "###0.00")
cost_PrintCutting = IIf(IsNull(rs("SumOfPriceCutting")), 0, rs("SumOfPriceCutting"))
objTable.Cell(14, 4).Range = Format(cost_PrintCutting, "###0.00")
End If
rs.Close
'ñòîèìîñòü ïîñëåïå÷àòè èç òàáëèöû "tblOrderPostPrint"
sSQL = "SELECT tblOrderPostPrint.OrderID, Sum(tblOrderPostPrint.PostPrintCostMaterial)" _
& " AS SumOfPostPrintCostMaterial, Sum(tblOrderPostPrint.PostPrintCostWork)" _
& " AS SumOfPostPrintCostWork" _
& " From tblOrderPostPrint" _
& " Where OrderID = " & id _
& " GROUP BY tblOrderPostPrint.OrderID"
rs.Open sSQL, cnn
If Not rs.EOF Then
cost_PostPrintWork = IIf(IsNull(rs("SumOfPostPrintCostWork")), 0, rs("SumOfPostPrintCostWork"))
objTable.Cell(15, 4).Range = Format(cost_PostPrintWork, "###0.00")
cost_PostPrintMaterial = IIf(IsNull(rs("SumOfPostPrintCostMaterial")), 0, rs("SumOfPostPrintCostMaterial"))
objTable.Cell(16, 4).Range = Format(cost_PostPrintMaterial, "###0.00")
End If
rs.Close
'âêëàäêà äîïîëíèòåëüíûå ðàáîòû
sSQL = "SELECT tblOrderAdditionalWork.OrderID, Sum(tblOrderAdditionalWork.Cost)" _
& " AS SumOfCost From tblOrderAdditionalWork" _
& " Where OrderID = " & id _
& " GROUP BY tblOrderAdditionalWork.OrderID"
rs.Open sSQL, cnn
If Not rs.EOF Then
cost_AdditionalWork = IIf(IsNull(rs("SumOfCost")), 0, rs("SumOfCost"))
objTable.Cell(17, 4).Range = Format(cost_Pay, "###0.00")
End If
rs.Close
cost_Total = cost_Design + cost_PrintWork + cost_PrintMaterial + cost_PrintCutting _
+ cost_PostPrintWork + cost_PostPrintMaterial + cost_AdditionalWork
objTable.Cell(18, 2).Range = Format(cost_Total, "###0.00")
'âêëàäêà îïëàòà
sSQL = "SELECT tblOrderPay.OrderID, Sum(tblOrderPay.PaySumma) AS SumOfPaySumma" _
& " From tblOrderPay" _
& " Where OrderID = " & id _
& " GROUP BY tblOrderPay.OrderID"
rs.Open sSQL, cnn
If Not rs.EOF Then
cost_Pay = IIf(IsNull(rs("SumOfPaySumma")), 0, rs("SumOfPaySumma"))
objTable.Cell(20, 2).Range = Format(cost_Pay, "###0.00")
End If
rs.Close
cost_Final = cost_Total - cost_Total * DiscountKoeff / 100# _
+ cost_Total * IncreaseKoeff / 100# - cost_Pay
objTable.Cell(24, 2).Range = Format(cost_Final, "###0.00")
L_Exit: Set rs = Nothing: Exit Sub
L_Err: MsgBox Err.Description & " (" & Err.Number & ")", vbExclamation, "update_Calculation": GoTo L_Exit
End Sub
|
| |
| |
| |
| |
|
|
| | СПАСИБО! Буду пробовать... | |
| |
| |
| |
|
|
| | А если в WORDE текст не в таблицах? | |
| |
| |
| |
|
|
| | Сделала так... Делюсь. Но на основе готового шаблона:
Private Sub cmdpech_Click()
Dim appWord As Word.Application
Dim docWord As Document
Dim sFileName As String
sFileName = App.Path & "\BLANK\Удостоверение.dot"
Set appWord = New Word.Application
Set docWord = appWord.Documents.Add(sFileName, False, wdFormLetters, True)
With docWord.MailMerge
.Destination = wdSendToNewDocument
.Execute (False)
appWord.Visible = True
docWord.SpellingChecked = False
End With
end sub | |
| |
| |
HiProg.com - Технологии программирования
|
