[Resolvido] Componente para Excel

[xanburzum 169]

Excel Code Component (XLA2.XLASheet2) gera um relatório sobre excel,dois parâmetro SQL e filename. Inclui também um método especial para lidar com os campos de data no relatório. Modifique esse código para suite suas necessidades.

 

' dim xla
' set xla = server.createobject("XLA2.XLASheet2")
' xla.CreatSheet("select.....","filename")
' -----------------------------------------------------------

Option Explicit
Private mselmon As Integer

Public Sub CreatSheet(Sql, Sheetname)
	Dim myfield As Field

	Dim myExcel As New Excel.Application
	Dim conn As New ADODB.Connection
	Dim rs As New ADODB.Recordset
	Dim x As Long
	Dim y As Long
	Dim i As Long
	
	conn.Open "TRC1"
	Set rs = conn.Execute(Sql)
	myExcel.Workbooks.Add
	x = 2
	y = 1
	For Each myfield In rs.Fields
		myExcel.Worksheets(1).Cells(x, y) = myfield.Name
		y = y + 1
	Next
	myExcel.Worksheets(1).Rows(2).Font.Bold = True
	myExcel.Worksheets(1).StandardWidth = 15
	myExcel.Worksheets(1).Rows(2).Select
	With myExcel.Selection.Interior
			.ColorIndex = 33
			.Pattern = xlSolid
	End With
 
	x = 3
	y = 1
	Do Until rs.EOF
		For i = 0 To rs.Fields.Count - 1
		If IsDate(rs.Fields(i)) Then
			myExcel.Worksheets(1).Cells(x, y) = Format(fmt(rs.Fields(i)), "mm/dd/yyyy")
			Else
			myExcel.Worksheets(1).Cells(x, y) = rs.Fields(i)
		End If
			y = y + 1
		Next
		myExcel.Worksheets(1).Rows(x).Select
		With myExcel.Selection.Interior
			.ColorIndex = 34
			.Pattern = xlSolid
	End With
		y = 1
		x = x + 1
		rs.MoveNext
	Loop
	On Error Resume Next
	myExcel.ActiveWorkbook.SaveAs Sheetname
	myExcel.Workbooks.Open Sheetname
	myExcel.Quit

End Sub

'método para formatar os campos de data no relatório
'----------------------------------------------
Private Function fmt(dat)
If IsDate(dat) Then
	If Month(dat) <> selmon Then
		fmt = " "
	Else
		fmt = dat
	End If
Else
	fmt = dat
End If
End Function

Public Property Get selmon() As Integer
selmon = mselmon
End Property

Public Property Let selmon(ByVal vNewValue As Integer)
mselmon = vNewValue
End Property