1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
| For intLoopRow = 0 To intRows - 1
'Создаем новый документ на основе шаблона
Set Doc = Nothing
If arrayRows(2, intLoopRow) = "Null" Or LCase(arrayRows(2, intLoopRow)) = "нет" Then
Set Doc = ObjWord.Documents.Add(PathDOT & "\" & "СлужебнаяЗапискаДО.doc")
Else
Set Doc = ObjWord.Documents.Add(PathDOT & "\" & "Распоряжение.doc")
End If
ObjWord.Visible = True
'Запрашиваем данные из базы
rstOrgProduct.Open "select * from ows.Opt_EskRaspOrgProduct " _
& "where feeYear = '" + CStr(arrayRows(3, intLoopRow)) + "' " _
& "and orgNAME = '" + CStr(arrayRows(1, intLoopRow)) + "' " _
& "and productNAME = '" + CStr(arrayRows(12, intLoopRow)) + "'", cnn
'Находим число записей в наборе
If Not rstOrgProduct.EOF Then
rstOrgProduct.MoveFirst
intRowsRst = 0
Do While Not rstOrgProduct.EOF
intRowsRst = intRowsRst + 1
rstOrgProduct.MoveNext
Loop
rstOrgProduct.MoveFirst
arrayRowsRst = rstOrgProduct.GetRows(intRowsRst)
Else
intRowsRst = 0
End If
'Вводим данные из массива в шаблон
With Doc.Bookmarks
.Item("OfficeCode").Range.Text = CStr(arrayRows(13, intLoopRow))
.Item("RaspNumber").Range.Text = CStr(intRaspNumber)
.Item("CurrDate").Range.Text = CStr(Date) + "г."
.Item("Name").Range.Text = arrayRows(1, intLoopRow)
Select Case CStr(arrayRowsRst(5, 0))
Case 810
strFeeType = "рублей 00 коп."
Case 840
strFeeType = "долларов 00 центов"
Case 978
strFeeType = "евро 00 евроцентов"
End Select
.Item("FeeYear").Range.Text = CStr(intRowsRst * CInt(arrayRows(3, intLoopRow))) + " " + strFeeType
.Item("FeeYears").Range.Text = TextSum(intRowsRst * CInt(arrayRows(3, intLoopRow)), arrayRowsRst(5, 0))
.Item("CardCount").Range.Text = intRowsRst
.Item("Month1Day").Range.Text = CStr(Month1Day) + "г."
If arrayRows(4, intLoopRow) <> "Null" Then
.Item("NoteDoc").Range.Text = arrayRows(4, intLoopRow)
Else
.Item("NoteDoc").Range.Text = "RDF" '?What needs?
End If
If arrayRows(2, intLoopRow) = "Null" Or LCase(arrayRows(2, intLoopRow)) = "нет" Then
If arrayRows(4, intLoopRow) <> "Null" Then
.Item("NoteDoc2").Range.Text = arrayRows(4, intLoopRow)
Else
.Item("NoteDoc2").Range.Text = "RDF" '?What needs?
End If
Else
.Item("BankAcc").Range.Text = "№ " & arrayRows(2, intLoopRow)
End If
.Item("FIO").Range.Text = strUserFIO
End With
'Переходим в конец документа
Doc.ActiveWindow.Selection.EndKey Unit:=wdStory
Doc.ActiveWindow.Selection.InsertBreak Type:=wdPageBreak
'Записываем название организации
Doc.ActiveWindow.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Doc.ActiveWindow.Selection.TypeText Text:="Руководителю предприятия"
Doc.ActiveWindow.Selection.TypeParagraph
Doc.ActiveWindow.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Doc.ActiveWindow.Selection.TypeText Text:= _
"Списки сотрудников для безакцептного списания за обслуживание карт по зарплатной " _
& "программе (Код - " + arrayRows(12, intOrg) + ") " + arrayRows(6, intOrg)
Doc.ActiveWindow.Selection.EndKey Unit:=wdStory
Doc.ActiveWindow.Selection.Font.Size = 10
'Создаем пустую таблицу
Set tblList = Doc.Tables.Add(Doc.ActiveWindow.Selection.Range, NumRows:=intRowsRst + 2, NumColumns:=4)
With tblList
If .Style <> "Сетка таблицы" Then
.Style = "Сетка таблицы"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
'.ApplyStyleRowBands = True
'.ApplyStyleColumnBands = False
End With
tblList.Select
'Заполнение таблицы
intItog = 0
tblList.Columns(1).Width = 45
tblList.Columns(2).Width = 250
tblList.Columns(3).Width = 100
tblList.Columns(4).Width = 75
tblList.Cell(1, 1).Range.InsertAfter "№ п/п"
tblList.Cell(1, 2).Range.InsertAfter "ФИО"
tblList.Cell(1, 3).Range.InsertAfter "Номер карты"
tblList.Cell(1, 4).Range.InsertAfter "Комиссия"
If intRowsRst <> 0 Then
For intRstOrgProduct = 0 To intRowsRst - 1
strClientName = CStr(arrayRowsRst(0, intRstOrgProduct)) + " " + CStr(arrayRowsRst(1, intRstOrgProduct))
If arrayRowsRst(2, intRstOrgProduct) <> "Null" Then
strClientName = strClientName + " " + CStr(arrayRowsRst(2, intRstOrgProduct))
End If
Select Case arrayRowsRst(5, intRstOrgProduct)
Case 810
strFeeType = "RUR"
Case 840
strFeeType = "USD"
Case 978
strFeeType = "EUR"
End Select
strFee = CStr(arrayRowsRst(4, intRstOrgProduct)) + ".00 " + strFeeType
tblList.Cell(intRstOrgProduct + 2, 1).Range.InsertAfter intRstOrgProduct + 1
tblList.Cell(intRstOrgProduct + 2, 2).Range.InsertAfter strClientName
tblList.Cell(intRstOrgProduct + 2, 3).Range.InsertAfter arrayRowsRst(3, intRstOrgProduct)
tblList.Cell(intRstOrgProduct + 2, 4).Range.InsertAfter strFee
intItog = intItog + CInt(arrayRowsRst(4, intRstOrgProduct))
Next
strItog = CStr(intItog) + ".00 " + strFeeType
tblList.Cell(intRstOrgProduct + 2, 2).Range.InsertAfter "Итого"
tblList.Cell(intRstOrgProduct + 2, 4).Range.InsertAfter strItog
End If
intOrg = intOrg + 1
'Инкремент номера распоряжения
intRaspNumber = intRaspNumber + 1
'Закрываем набор данных
rstOrgProduct.Close
'Переходим в начало документа
Doc.ActiveWindow.Selection.HomeKey Unit:=wdStory
'задаем путь к конечному создаваемому каталогу
strPathDir = "F:\CARD_FEE_YEARLY\" + CStr(Year(Date)) + "-" + CStr(Month(Date)) + "\"
'проверяем, есть ли такой путь и если нету, вызываем процедуру
'для создания соответствующих каталогов
If Dir(strPathDir, vbDirectory) = "" Then
Call MakeTreeDirectory(strPathDir)
End If
'Сохраняем документ
strFileName = strPathDir + CStr(arrayRows(6, intLoopRow)) + " fee " + _
CStr(arrayRows(3, intLoopRow)) + " prod " + CStr(arrayRows(12, intLoopRow)) + ".doc"
Doc.SaveAs (strFileName)
'Печать документа
Doc.PrintOut
Doc.Close wdSaveChanges
Next |
(
