Передача таблицы в EXCEL

[bel62]

Подскажите, как решить проблему в скрипте.
Создаю подключение к БД, как показано ниже.
Вывожу таблицу, как показано на рисунке "Таблица запроса SQL.JPG".
Таблица включает несколько строк. Кол-во строк может быть разной, так как данные в БД часто меняются.
Пробую передать всю таблицу в EXCEL, но передаётся только одна строка, как показано на рисунке "Отчет.JPG".
Необходимо передать все строки. Как этот цикл правильно прописать в скрипте? Где ошибка?

Function Kro2()
	Dim Par(5)
	Dim StartRow
	Dim Rows1,Rows2,Rows3
	Dim MatName
	Dim MatTypeName
	Dim UnitsName
	Dim Count
	Dim Price

	LastRow=LastRow+Rows1+1

	Set ObjCnMB = CreateObject("ADODB.Connection")
 	 	ObjCnMB.Provider = "Microsoft.Jet.OLEDB.4.0"
 	 	ObjCnMB.ConnectionString = "C:\New1.mdb"
	 	ObjCnMB.Open
	Set objRs1 = CreateObject("ADODB.Recordset")
	 	objRs1.CursorType = 1
	
	SQLStr1 = "SELECT tn.Name, tn.MatTypeName, ""кв.м"" AS UnitsName, Sum(td.Square*te.[Count]), tn.Price FROM TNNomenclature tn, "& _
						"TNPropertyValues tpv, TDecorates td, TElems te Where tn.ID=td.MaterialID AND "& _
						"tpv.EntityID=tn.ID AND te.UnitPos=td.UnitPos AND tpv.PropertyID=(SELECT ID FROM TNProperties WHERE TNProperties.Ident='WasteCoeff') "& _
						"Group By tn.Name, tn.MatTypeName, td.MaterialID, tn.Price, tpv.DValue "& _
						"Order By td.MaterialID asc, tn.Name asc "

	objRs1.Open SqlStr1,ObjCnMB
	Rows1 = objRs1.RecordCount
	If Rows1 = 0 Then
		objRs1.Close
		Exit Function
	End If
	LastRow=LastRow+1
	Str = "Отделки"
	ObjExcel.Range("A"&(LastRow)).Value = Str 
	MyRamka("A"&(LastRow+1)&":"&"H"&(LastRow+Rows1))
		objRs1.MoveFirst

	StartRow=LastRow
	 	For I = 1 To Rows			 
		Next			 	
		LastRow = LastRow						
		
	Par(0) = objRs1.Fields(0)		'	MatName
	Par(1) = objRs1.Fields(1)		'	MatTypeName	
	Par(2) = objRs1.Fields(2)		'	UnitsName
	Par(3) = objRs1.Fields(3) 	              '	Count
	Par(4) = objRs1.Fields(4)		'	Price	

	Str=0
		ObjExcel.Range("A"&(LastRow+I)).Value = Par(0)
		ObjExcel.Range("C"&(LastRow+I)).Value = Par(1)
		ObjExcel.Range("E"&(LastRow+I)).Value = Par(2)
		ObjExcel.Range("F"&(LastRow+I)).Value = Par(3)
		ObjExcel.Range("G"&(LastRow+I)).Value = Par(4)
		ObjExcel.ActiveSheet.Cells(LastRow+I,8).Formula = "=F"&(LastRow+I)&"*G"&(LastRow+I)

	ObjExcel.Range("G"&(LastRow+I)).Select
	ObjExcel.ActiveSheet.Cells(LastRow+I,6).NumberFormat="0.00"
	ObjExcel.ActiveSheet.Cells(LastRow+I,7).NumberFormat="0.0"
	ObjExcel.ActiveSheet.Cells(LastRow+I,8).NumberFormat="0.0"

		ObjExcel.Range("H"&(LastRow+I)).Select
		ObjExcel.ActiveSheet.Cells(LastRow+I,8).NumberFormat="0.00"
		Total = Total+Str
		objRs1.MoveNext
	LastRow=LastRow+Rows1+1
	objRs1.Close	
End Function

[IgorGO]

пробуйте так:

	 	For I = 1 To Rows1			 
	'	LastRow = LastRow						
		
	Par(0) = objRs1.Fields(0)		'	MatName
	Par(1) = objRs1.Fields(1)		'	MatTypeName	
	Par(2) = objRs1.Fields(2)		'	UnitsName
	Par(3) = objRs1.Fields(3) 	              '	Count
	Par(4) = objRs1.Fields(4)		'	Price	

	Str=0
		ObjExcel.Range("A"&(LastRow+I)).Value = Par(0)
		ObjExcel.Range("C"&(LastRow+I)).Value = Par(1)
		ObjExcel.Range("E"&(LastRow+I)).Value = Par(2)
		ObjExcel.Range("F"&(LastRow+I)).Value = Par(3)
		ObjExcel.Range("G"&(LastRow+I)).Value = Par(4)
		ObjExcel.ActiveSheet.Cells(LastRow+I,8).Formula = "=F"&(LastRow+I)&"*G"&(LastRow+I)

	ObjExcel.Range("G"&(LastRow+I)).Select
	ObjExcel.ActiveSheet.Cells(LastRow+I,6).NumberFormat="0.00"
	ObjExcel.ActiveSheet.Cells(LastRow+I,7).NumberFormat="0.0"
	ObjExcel.ActiveSheet.Cells(LastRow+I,8).NumberFormat="0.0"

		ObjExcel.Range("H"&(LastRow+I)).Select
		ObjExcel.ActiveSheet.Cells(LastRow+I,8).NumberFormat="0.00"
		Total = Total+Str
		objRs1.MoveNext
		Next

[bel62]

Сообщение от IgorGO

пробуйте так:

	 	For I = 1 To Rows1			 
	'	LastRow = LastRow						
		
	Par(0) = objRs1.Fields(0)		'	MatName
	Par(1) = objRs1.Fields(1)		'	MatTypeName	
	Par(2) = objRs1.Fields(2)		'	UnitsName
	Par(3) = objRs1.Fields(3) 	              '	Count
	Par(4) = objRs1.Fields(4)		'	Price	

	Str=0
		ObjExcel.Range("A"&(LastRow+I)).Value = Par(0)
		ObjExcel.Range("C"&(LastRow+I)).Value = Par(1)
		ObjExcel.Range("E"&(LastRow+I)).Value = Par(2)
		ObjExcel.Range("F"&(LastRow+I)).Value = Par(3)
		ObjExcel.Range("G"&(LastRow+I)).Value = Par(4)
		ObjExcel.ActiveSheet.Cells(LastRow+I,8).Formula = "=F"&(LastRow+I)&"*G"&(LastRow+I)

	ObjExcel.Range("G"&(LastRow+I)).Select
	ObjExcel.ActiveSheet.Cells(LastRow+I,6).NumberFormat="0.00"
	ObjExcel.ActiveSheet.Cells(LastRow+I,7).NumberFormat="0.0"
	ObjExcel.ActiveSheet.Cells(LastRow+I,8).NumberFormat="0.0"

		ObjExcel.Range("H"&(LastRow+I)).Select
		ObjExcel.ActiveSheet.Cells(LastRow+I,8).NumberFormat="0.00"
		Total = Total+Str
		objRs1.MoveNext
		Next

Спасибо, вопрос решил
Яндекс