[RESOLVED] VB6 Excel Autofilter
Hey guys i wanted to automactly set the autofilter on every report i generate. The only way i found to do it was copy pasting the code from a macro like :
Code:
Range("A4").Select
Selection.AutoFilter
The problem is that when i try to generate another sheet without closing the first one the 2nd one woun't have the autofilter nor the first as it will disapear :ehh: Any other way to do this? And i dont know if there a need to post the code but if there is :
This is a bit uncorrect to do i think :sick: I've downloaded a project and edited it it shows a form where you have to select which report you want to generate. So i added the if statements and it's a little big. If there's a need to optimize the code help would be appreciated as well :blush:
Code:
Private Sub CmdExport_Click()
On Error Resume Next
Dim lc, NxtLine, k
If Trim(LstCode.Text) = "Formandos" Then
'**********************************************
'Folha dos formandos
'**********************************************
Screen.MousePointer = vbHourglass
connect
Set ExlObj = CreateObject("excel.application") ' Initialize the excel object
ExlObj.Workbooks.Add ' Add an excel workbook
' Get the required data from the database
rsGetAllData.Open "select numero_sigo,tipo_documento,numero_identificaçao,data_validade_id,telefone1,data_nascimento,idade,habilitaçoes,profissão,data_inscriçao,data_juri,estado_curso,observaçoes from formandos", con, adOpenDynamic, adLockOptimistic
If Not rsGetAllData.EOF Then
ExlObj.Visible = True ' Show the excel sheet
With ExlObj.ActiveSheet
' Print the heading and columns first
.Cells(1, 3).Value = "Centro de Novas Oportunidades"
.Cells(1, 3).Font.Name = "Verdana"
.Cells(1, 3).Font.Bold = True
.Cells(4, 1).Value = "SIGO"
.Cells(4, 2).Value = "Documento"
.Cells(4, 3).Value = "Nº Doc."
.Cells(4, 4).Value = "Data Valid."
.Cells(4, 5).Value = "Contacto"
.Cells(4, 6).Value = "Data Nasc."
.Cells(4, 7).Value = "Idade"
.Cells(4, 8).Value = "Habilitações"
.Cells(4, 9).Value = "Profissão"
.Cells(4, 10).Value = "Data Inscrição"
.Cells(4, 11).Value = "Juri"
.Cells(4, 12).Value = "Estado Processo"
.Cells(4, 13).Value = "Obervações"
End With
End If
For k = 1 To rsGetAllData.Fields.Count
' Column headings are set to bold and white.
ExlObj.ActiveSheet.Cells(4, k).Font.Bold = True
ExlObj.ActiveSheet.Cells(4, k).Font.Color = vbWhite
Next
Set k = Nothing
NxtLine = 5
Range("A4").Select
Selection.AutoFilter
ElseIf Trim(LstCode.Text) = "Pessoal" Then
'**********************************************
'Folha do pessoal
'**********************************************
Screen.MousePointer = vbHourglass
connect
Set ExlObj = CreateObject("excel.application") ' Initialize the excel object
ExlObj.Workbooks.Add ' Add an excel workbook
' Get the required data from the database
rsGetAllData.Open "select numero_sigo_pessoal,tipo_documento_pessoal,numero_identificaçao_pessoal,data_validade_id_pessoal,telefone1,data_nascimento_pessoal,idade_pessoal,funçao_pessoal from pessoal", con, adOpenDynamic, adLockOptimistic
If Not rsGetAllData.EOF Then
ExlObj.Visible = True ' Show the excel sheet
With ExlObj.ActiveSheet
' Print the heading and columns first
.Cells(1, 3).Value = "Centro de Novas Oportunidades"
.Cells(1, 3).Font.Name = "Verdana"
.Cells(1, 3).Font.Bold = True
.Cells(4, 1).Value = "SIGO"
.Cells(4, 2).Value = "Documento"
.Cells(4, 3).Value = "Nº Doc."
.Cells(4, 4).Value = "Data Valid."
.Cells(4, 5).Value = "Contacto"
.Cells(4, 6).Value = "Data Nasc."
.Cells(4, 7).Value = "Idade"
.Cells(4, 8).Value = "Função"
End With
End If
For k = 1 To rsGetAllData.Fields.Count
' Column headings are set to bold and white.
ExlObj.ActiveSheet.Cells(4, k).Font.Bold = True
ExlObj.ActiveSheet.Cells(4, k).Font.Color = vbWhite
Next
Set k = Nothing
NxtLine = 5
Range("B4").Select
Selection.AutoFilter
ElseIf Trim(LstCode.Text) = "Sessões" Then
'**********************************************
'Folha das Sessões
'**********************************************
Screen.MousePointer = vbHourglass
connect
Set ExlObj = CreateObject("excel.application") ' Initialize the excel object
ExlObj.Workbooks.Add ' Add an excel workbook
' Get the required data from the database
rsGetAllData.Open "select numero_sigo_pessoal,tipo_documento_pessoal,numero_identificaçao_pessoal,data_validade_id_pessoal,telefone1,data_nascimento_pessoal,idade_pessoal,funçao_pessoal from pessoal", con, adOpenDynamic, adLockOptimistic
If Not rsGetAllData.EOF Then
ExlObj.Visible = True ' Show the excel sheet
With ExlObj.ActiveSheet
' Print the heading and columns first
.Cells(1, 3).Value = "Centro de Novas Oportunidades"
.Cells(1, 3).Font.Name = "Verdana"
.Cells(1, 3).Font.Bold = True
.Cells(4, 1).Value = "SIGO"
.Cells(4, 2).Value = "Documento"
.Cells(4, 3).Value = "Nº Doc."
.Cells(4, 4).Value = "Data Valid."
.Cells(4, 5).Value = "Contacto"
.Cells(4, 6).Value = "Data Nasc."
.Cells(4, 7).Value = "Idade"
.Cells(4, 8).Value = "Função"
End With
End If
For k = 1 To rsGetAllData.Fields.Count
' Column headings are set to bold and white.
ExlObj.ActiveSheet.Cells(4, k).Font.Bold = True
ExlObj.ActiveSheet.Cells(4, k).Font.Color = vbWhite
Next
Set k = Nothing
NxtLine = 5
Range("A4").Select
Selection.AutoFilter
Else
MsgBox ("Por fazer.")
Exit Sub
End If
' Now we will export data into the sheet
Do Until rsGetAllData.EOF
For lc = 0 To rsGetAllData.Fields.Count - 1
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = rsGetAllData.Fields(lc)
If rsGetAllData.Fields.Item(lc).Name <> "DATE" Then
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = rsGetAllData.Fields(lc)
Else
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = rsGetAllData.Fields(lc)
End If
Next
rsGetAllData.MoveNext
NxtLine = NxtLine + 1
Loop
' Once the data has been exported, we will format the sheet _
by using the AutoFormat function.
ExlObj.ActiveCell.Worksheet.Cells(NxtLine, lc + 1).AutoFormat _
xlRangeAutoFormatList2, 0, regular, 3, 1, True, True
'ExlObj.ActiveCell.Worksheet.Cells.AutoFormat '<- Click the space key after _
.AutoFormat to see its _
parameter types.
Screen.MousePointer = vbDefault
End Sub
