Доброго времени суток. Помогите, пожалуйста, своими наработками и советами.
Стоит задача формировать отчет в excell из программы, написаной на vb. Отчеты получаются достаточно большие по содержанию.
Сейчас сделал следующий вариант (см. ниже), но у него есть несколько недостатков:
1. достаточно медленно формируется отчет
2. Если во время формирования сделать активным окно экселя, то выскакивает ошибка.
3. нет прогресс бара при формировании отчета.
Область, куда вставлять данные и которую нужно размножать до необходимого количества называю как Lblock1
Ячейки, куда нужно вставлять информацию помечаю примечанием по названию столбца в sql запросе, который возвращает данные для отчета.
Может кто поделится своими наработками на данную тему. Очень нужно сделать стабильный и шустрый вариант.
Заранее всем огромное спасибо!
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.
Sub PrintExcell(ByVal FTempl As String)
Dim PathTemplate As String
Dim PathTemp As String
Dim Frep As String
Dim XL As Object
Dim LblockNum As String = "LBlock1"
Dim Cn As String
Dim I As Integer, J As Integer, X As Integer
Dim cRow As Integer, cCol As Integer, mCol As Integer
PathTemplate = "v:\Inversion\ufs\"
PathTemp = "u:\Temp\"
Frep = PathTemp & FTempl
FTempl = PathTemplate & FTempl
If Not My.Computer.FileSystem.FileExists(FTempl) Then
MsgBox("Нет шаблона")
Exit Sub
Else
If Check_Free_File(FTempl, Frep) = False Then
Exit Sub
Else
If Not My.Computer.FileSystem.FileExists(Frep) Then
Else
XL = ldObjExcel(Frep)
With XL
.Workbooks.Open(FileName:=Frep)
.Worksheets(1).Activate()
.ScreenUpdating = True
.Visible = False
End With
XL.Application.Range(LblockNum).Select()
cRow = XL.Selection.Row
mCol = XL.Application.Range(LblockNum).Columns.Count
If mCol > 100 Then mCol = 100
XL.ActiveSheet.Rows(cRow + 1 & ":" & cRow + 1).Select()
Dim Comm As New OleDb.OleDbCommand(Sql, Connect)
Dim DR As OleDbDataReader
DR = Comm.ExecuteReader()
I = 0
ReDim MRes(0, 0)
While DR.Read()
If I > 0 Then
XL.Selection.Insert()
End If
ReDim Preserve MRes(DR.FieldCount - 1, I)
For X = 0 To DR.FieldCount - 1
If IsDBNull(DR(X)) Then
MRes(X, I) = Nothing
Else
MRes(X, i) = DR(X)
End If
Next
End While
DR.Close()
DR = Comm.ExecuteReader()
I = 0
While DR.Read()
For cCol = 1 To mCol
Cn = ""
For J = 0 To DR.FieldCount - 1
If Not XL.ActiveSheet.Cells(cRow, cCol).Comment Is Nothing Then
Cn = UCase(XL.ActiveSheet.Cells(cRow, cCol).Comment.Text)
End If
If Cn = UCase(DR.GetName(J)) Then
If Not IsDBNull(DR.Item(J)) Then
XL.ActiveSheet.Cells(cRow + I, cCol).Value = DR.Item(J)
Else
XL.ActiveSheet.Cells(cRow + I, cCol).Value = ""
End If
End If
Next
Next
I = I + 1
End While
DR.Close()
DR = Nothing
Comm = Nothing
XL.visible = True
End If
End If
End If
End Sub
