CRIAR MAIS QUE 3 ABAS EM PLANILHA EXCEL
Boa tarde galera, Tenho uma aplicação em vb6 em que exporto os dados de um Record set direto para um arquivo .XLS
entretando não consigo colocar mais que 3 abas no arquivo excel. Quem poder me ajudar agradeço, forte abraço
Code:
// Tipo criado
Option Explict
Private Type ExlCell
row As Long
col As Long
End Type
/// Função para colocar o RS na planilha
Private Sub CopyRecords(ByRef rs As ADODB.Recordset, ByRef ws As Variant, ByRef StartingCell As ExlCell)
Dim SomeArray() As Variant
Dim row As Long, col As Long
Dim fd As Field
rs.MoveLast
ReDim SomeArray(rs.RecordCount + 1, rs.Fields.Count)
[ô] Copia as colunas do cabecalho para um vetor
col = 0
For Each fd In rs.Fields
SomeArray(0, col) = fd.Name
col = col + 1
Next
[ô] copia o rs par um vetor
rs.MoveFirst
For row = 1 To rs.RecordCount
For col = 0 To rs.Fields.Count - 1
SomeArray(row, col) = rs.Fields(col).Value
[ô] O Excel não suporta valores NULL em uma célula.
If IsNull(SomeArray(row, col)) Then _
SomeArray(row, col) = [Ô]0[Ô]
Next
rs.MoveNext
Next
ws.Range(ws.Cells(StartingCell.row, StartingCell.col), _
ws.Cells(StartingCell.row + rs.RecordCount + 1, _
StartingCell.col + rs.Fields.Count)).Value = SomeArray
End Sub
// Clique do exportar
Private Sub btnGerarXLS_Click()
Dim NomeArquivo As String
Dim oExcel As Object
Dim objExlSht As Object
Dim stCell As ExlCell
Dim Sn As Recordset
On Error GoTo trata_erro
DlgSalvar.CancelError = True
DlgSalvar.Filter = [Ô]Planilha Excel (*.xls)|*.xls[Ô]
DlgSalvar.ShowSave
NomeArquivo = DlgSalvar.filename
MousePointer = vbHourglass
Set oExcel = CreateObject([Ô]Excel.Application[Ô])
oExcel.Workbooks.Add
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1) --- ???????? vide explicação abaixo
STRSQL = [Ô] SELECT <campos> FROM <tabela>[Ô]
rsNh.Open STRSQL, conNh, adOpenStatic, adLockReadOnly
Set Sn = rsNh.Clone
rsNh.Close
stCell.row = 1
stCell.col = 1
Call CopyRecords(Sn, objExlSht, stCell)
Set Sn = Nothing
End Sub
???????--- Faço isso mais duas vezes, assim fico com (...)Sheets(1) ; (...)Sheets(2); (...)Sheets(3).
preciso gerar mais planilhas.
entretando não consigo colocar mais que 3 abas no arquivo excel. Quem poder me ajudar agradeço, forte abraço
Code:
// Tipo criado
Option Explict
Private Type ExlCell
row As Long
col As Long
End Type
/// Função para colocar o RS na planilha
Private Sub CopyRecords(ByRef rs As ADODB.Recordset, ByRef ws As Variant, ByRef StartingCell As ExlCell)
Dim SomeArray() As Variant
Dim row As Long, col As Long
Dim fd As Field
rs.MoveLast
ReDim SomeArray(rs.RecordCount + 1, rs.Fields.Count)
[ô] Copia as colunas do cabecalho para um vetor
col = 0
For Each fd In rs.Fields
SomeArray(0, col) = fd.Name
col = col + 1
Next
[ô] copia o rs par um vetor
rs.MoveFirst
For row = 1 To rs.RecordCount
For col = 0 To rs.Fields.Count - 1
SomeArray(row, col) = rs.Fields(col).Value
[ô] O Excel não suporta valores NULL em uma célula.
If IsNull(SomeArray(row, col)) Then _
SomeArray(row, col) = [Ô]0[Ô]
Next
rs.MoveNext
Next
ws.Range(ws.Cells(StartingCell.row, StartingCell.col), _
ws.Cells(StartingCell.row + rs.RecordCount + 1, _
StartingCell.col + rs.Fields.Count)).Value = SomeArray
End Sub
// Clique do exportar
Private Sub btnGerarXLS_Click()
Dim NomeArquivo As String
Dim oExcel As Object
Dim objExlSht As Object
Dim stCell As ExlCell
Dim Sn As Recordset
On Error GoTo trata_erro
DlgSalvar.CancelError = True
DlgSalvar.Filter = [Ô]Planilha Excel (*.xls)|*.xls[Ô]
DlgSalvar.ShowSave
NomeArquivo = DlgSalvar.filename
MousePointer = vbHourglass
Set oExcel = CreateObject([Ô]Excel.Application[Ô])
oExcel.Workbooks.Add
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1) --- ???????? vide explicação abaixo
STRSQL = [Ô] SELECT <campos> FROM <tabela>[Ô]
rsNh.Open STRSQL, conNh, adOpenStatic, adLockReadOnly
Set Sn = rsNh.Clone
rsNh.Close
stCell.row = 1
stCell.col = 1
Call CopyRecords(Sn, objExlSht, stCell)
Set Sn = Nothing
End Sub
???????--- Faço isso mais duas vezes, assim fico com (...)Sheets(1) ; (...)Sheets(2); (...)Sheets(3).
preciso gerar mais planilhas.
Boa tarde, isso acontece porque o Excel vem configurado para 3 planilhas ao se criar um workbook, isso pode ser configurado no proprio Excel, manualmente ou via código.
Mas o interessante pra vc acho que ao inves de setar uma planilha já existente sete uma nova.
Private Sub btnGerarXLS_Click()
Dim NomeArquivo As String
Dim oExcel As Object
Dim oWorkbook As Object
Dim objExlSht As Object
Dim stCell As ExlCell
Dim Sn As Recordset
On Error GoTo trata_erro
DlgSalvar.CancelError = True
DlgSalvar.Filter = [Ô]Planilha Excel (*.xls)|*.xls[Ô]
DlgSalvar.ShowSave
NomeArquivo = DlgSalvar.filename
MousePointer = vbHourglass
Set oExcel = CreateObject([Ô]Excel.Application[Ô])
Set oWorkbook = oExcel.Workbooks.Add
Set objExlSht = oWorkbook.Worksheets.Add
Assim independente da quantidade de sheet existentes será criada uma nova sheet e vc ira estar utilizando essa sheet.
Abraço
Mas o interessante pra vc acho que ao inves de setar uma planilha já existente sete uma nova.
Private Sub btnGerarXLS_Click()
Dim NomeArquivo As String
Dim oExcel As Object
Dim oWorkbook As Object
Dim objExlSht As Object
Dim stCell As ExlCell
Dim Sn As Recordset
On Error GoTo trata_erro
DlgSalvar.CancelError = True
DlgSalvar.Filter = [Ô]Planilha Excel (*.xls)|*.xls[Ô]
DlgSalvar.ShowSave
NomeArquivo = DlgSalvar.filename
MousePointer = vbHourglass
Set oExcel = CreateObject([Ô]Excel.Application[Ô])
Set oWorkbook = oExcel.Workbooks.Add
Set objExlSht = oWorkbook.Worksheets.Add
Assim independente da quantidade de sheet existentes será criada uma nova sheet e vc ira estar utilizando essa sheet.
Abraço
Fala Mitsueda,
Cara fantástico essa sua proposta do solução. consegui incluir mais planilhas na minha pasta de trabalho.
Da forma que esta agora funciona.
Eviste alguma forma de eu colocar as novas Sheets no final, pois qnd uso o [Ô]Set objExlSht = oWorkbook.Worksheets.Add [Ô] a minha nova Sheet fica ocupando o lugar da minha Plan 1 ?
fica assim:
New Sheet || New Sheet || Plan 1|| Plan2 || Plan 3
caso não tenha como alterar o ponto de inserção da nova Sheet no WorkBook está bom.
Valeu msm
Forte abraço.
Cara fantástico essa sua proposta do solução. consegui incluir mais planilhas na minha pasta de trabalho.
Da forma que esta agora funciona.
Eviste alguma forma de eu colocar as novas Sheets no final, pois qnd uso o [Ô]Set objExlSht = oWorkbook.Worksheets.Add [Ô] a minha nova Sheet fica ocupando o lugar da minha Plan 1 ?
fica assim:
New Sheet || New Sheet || Plan 1|| Plan2 || Plan 3
caso não tenha como alterar o ponto de inserção da nova Sheet no WorkBook está bom.
Valeu msm
Forte abraço.
Pra tudo se da um jeito rs...
Private Sub btnGerarXLS_Click()
Dim NomeArquivo As String
Dim oExcel As Object
Dim oWorkbook As Object
Dim objExlSht As Object
Dim stCell As ExlCell
Dim Sn As Recordset
Dim x As Integer
On Error GoTo trata_erro
DlgSalvar.CancelError = True
DlgSalvar.Filter = [Ô]Planilha Excel (*.xls)|*.xls[Ô]
DlgSalvar.ShowSave
NomeArquivo = DlgSalvar.filename
MousePointer = vbHourglass
Set oExcel = CreateObject([Ô]Excel.Application[Ô])
Set oWorkbook = oExcel.Workbooks.Add
Set objExlSht = oWorkbook.Worksheets.Add
[txt-color=#007100][ô]Aqui eu capturo a quantidade de planilhas após a insersão da ultima[/txt-color]
x = oWorkbook.Sheets.Count
[txt-color=#007100][ô]Aqui eu alteroa posição com base na quantidade[/txt-color]
objExlSht.Move After:=Sheets(x)
[txt-color=#007100][ô]é possivel também alterar-se o nome da planilha[/txt-color]
objExlSht.Name = [Ô]Customizado[Ô] [txt-color=#007100][ô]Só tem que prestar atenção pra não inserir nenhum caractere especial ou ultrapassar 29 caracteres[/txt-color]
Abraço
Private Sub btnGerarXLS_Click()
Dim NomeArquivo As String
Dim oExcel As Object
Dim oWorkbook As Object
Dim objExlSht As Object
Dim stCell As ExlCell
Dim Sn As Recordset
Dim x As Integer
On Error GoTo trata_erro
DlgSalvar.CancelError = True
DlgSalvar.Filter = [Ô]Planilha Excel (*.xls)|*.xls[Ô]
DlgSalvar.ShowSave
NomeArquivo = DlgSalvar.filename
MousePointer = vbHourglass
Set oExcel = CreateObject([Ô]Excel.Application[Ô])
Set oWorkbook = oExcel.Workbooks.Add
Set objExlSht = oWorkbook.Worksheets.Add
[txt-color=#007100][ô]Aqui eu capturo a quantidade de planilhas após a insersão da ultima[/txt-color]
x = oWorkbook.Sheets.Count
[txt-color=#007100][ô]Aqui eu alteroa posição com base na quantidade[/txt-color]
objExlSht.Move After:=Sheets(x)
[txt-color=#007100][ô]é possivel também alterar-se o nome da planilha[/txt-color]
objExlSht.Name = [Ô]Customizado[Ô] [txt-color=#007100][ô]Só tem que prestar atenção pra não inserir nenhum caractere especial ou ultrapassar 29 caracteres[/txt-color]
Abraço
Há esqueci que vc não está usando referencia no seu projeto então substitua a linha abaixo
[txt-color=#007100][ô]Aqui eu alteroa posição com base na quantidade[/txt-color]
objExlSht.Move After:=Sheets(x)
Pela linha abaixo
[txt-color=#007100][ô]Aqui eu alteroa posição com base na quantidade[/txt-color]
objExlSht.Move After:=oWorkbook.Sheets(x)
Abraços
[txt-color=#007100][ô]Aqui eu alteroa posição com base na quantidade[/txt-color]
objExlSht.Move After:=Sheets(x)
Pela linha abaixo
[txt-color=#007100][ô]Aqui eu alteroa posição com base na quantidade[/txt-color]
objExlSht.Move After:=oWorkbook.Sheets(x)
Abraços
eu tinha visto algo dste tipo mas em VBA, pelo q vc esta me mostrando é praticamente a mesma coisa
a aprada de rotular as planilhas eu tinha achado aqui na net... vou fazer desta forma que vc está me sugirindo e posto aqui a solução final.. valeu garoto abraços
a aprada de rotular as planilhas eu tinha achado aqui na net... vou fazer desta forma que vc está me sugirindo e posto aqui a solução final.. valeu garoto abraços
Nao sei se isso te ajudaria ou nao, mas uso a rotina abaixo pra verificar se uma pasta ja existe no excel, se existir seleciono ela, se nao existir, eu crio
Espero que isso ajude.
If VerificaBanco(Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])) Then
Sheets(Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])).Select
Else
Sheets.Add().Name = Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])
Sheets(Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])).Select
Sheets(Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])).Move Before:=Sheets(1)
End If
Function VerificaBanco(Banco)
Achei = False
For x = 1 To Worksheets.Count
Nome = Worksheets.Item(x).Name
If Nome = Banco Then
Achei = True
Exit For
End If
Next x
If Achei Then
VerificaBanco = True
Else
VerificaBanco = False
End If
End Function
Espero que isso ajude.
If VerificaBanco(Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])) Then
Sheets(Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])).Select
Else
Sheets.Add().Name = Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])
Sheets(Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])).Select
Sheets(Replace(Trim(Filial), [Ô]/[Ô], [Ô]-[Ô])).Move Before:=Sheets(1)
End If
Function VerificaBanco(Banco)
Achei = False
For x = 1 To Worksheets.Count
Nome = Worksheets.Item(x).Name
If Nome = Banco Then
Achei = True
Exit For
End If
Next x
If Achei Then
VerificaBanco = True
Else
VerificaBanco = False
End If
End Function
Fala Pessoal consegui resolver \o/
Vou postar a programação do click do botão de exportar Completo
Muito obrigadoa todos.
MITSUEDA, brothe ve é fera !!!!
Vou postar a programação do click do botão de exportar Completo
Muito obrigadoa todos.
MITSUEDA, brothe ve é fera !!!!
Option Explicit
Private Type ExlCell
row As Long
col As Long
End Type
Private Sub CopyRecords(ByRef rs As ADODB.Recordset, ByRef ws As Variant, ByRef StartingCell As ExlCell)
Dim SomeArray() As Variant
Dim row As Long, col As Long
Dim fd As Field
rs.MoveLast
ReDim SomeArray(rs.RecordCount + 1, rs.Fields.Count)
[ô] Copia as colunas do cabecalho para um vetor
col = 0
For Each fd In rs.Fields
SomeArray(0, col) = fd.Name
col = col + 1
Next
[ô] copia o rs par um vetor
rs.MoveFirst
For row = 1 To rs.RecordCount
For col = 0 To rs.Fields.Count - 1
SomeArray(row, col) = rs.Fields(col).Value
[ô] O Excel não suporta valores NULL em uma célula.
If IsNull(SomeArray(row, col)) Then _
SomeArray(row, col) = [Ô]0[Ô]
Next
rs.MoveNext
Next
ws.Range(ws.Cells(StartingCell.row, StartingCell.col), _
ws.Cells(StartingCell.row + rs.RecordCount + 1, _
StartingCell.col + rs.Fields.Count)).Value = SomeArray
End Sub
Sub btnGerarXLS_Click()
Dim NomeArquivo As String
Dim oExcel As Object
Dim objExlSht As Object
Dim stCell As ExlCell
Dim oWorkbook As Object
Dim Sn As Recordset
Dim contaPlanilha As Integer
On Error GoTo trata_erro
DlgSalvar.CancelError = True
DlgSalvar.Filter = [Ô]Planilha Excel (*.xls)|*.xls[Ô]
DlgSalvar.ShowSave
NomeArquivo = DlgSalvar.filename
MousePointer = vbHourglass
Set oExcel = CreateObject([Ô]Excel.Application[Ô])
Set oWorkbook = oExcel.Workbooks.Add
[ô]PLANILHA DE CHAMADAS
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)
objExlSht.Name = [Ô]CHAMADAS[Ô]
STRSQL = [Ô] SELECT [Ô]
STRSQL = STRSQL & [Ô] QTE_NORMAL_CH AS LIG_NORMAL,[Ô]
STRSQL = STRSQL & [Ô] DURACAO_NORMAL_CH AS TEMPO_NORMAL,[Ô]
STRSQL = STRSQL & [Ô] QTE_REDUZIDO_CH AS LIG_REDUZIDO,[Ô]
STRSQL = STRSQL & [Ô] DURACAO_REDUZIDO_CH As TEMPO_REDUZIDO[Ô]
STRSQL = STRSQL & [Ô] From[Ô]
STRSQL = STRSQL & [Ô] TBL_CHAMADA[Ô]
STRSQL = STRSQL & [Ô] Where[Ô]
STRSQL = STRSQL & [Ô] DATA_CH LIKE [ô][Ô] & lblData.Caption & [Ô][ô][Ô]
STRSQL = STRSQL & [Ô] AND ID_BD_CH = [Ô] & lblIdBanco.Caption
rsNh.Open STRSQL, conNh, adOpenStatic, adLockReadOnly
Set Sn = rsNh.Clone
rsNh.Close
stCell.row = 1
stCell.col = 1
Call CopyRecords(Sn, objExlSht, stCell)
Set Sn = Nothing
[ô] PLANILHA DE CLIENTES
Set objExlSht = oExcel.ActiveWorkbook.Sheets(2)
objExlSht.Name = [Ô]CLIENTES[Ô]
STRSQL = [Ô]SELECT [Ô]
STRSQL = STRSQL & [Ô] DN.ID_DN,[Ô]
STRSQL = STRSQL & [Ô] D.DESCRICAO_DESC AS DESCRICAO_DN, [Ô]
STRSQL = STRSQL & [Ô] DN.DATA_DN,[Ô]
STRSQL = STRSQL & [Ô] DN.LIG_NORMAL_DN ,[Ô]
STRSQL = STRSQL & [Ô] DN.TEMPO_NORMAL_DN,[Ô]
STRSQL = STRSQL & [Ô] DN.LIG_REDUZIDO_DN[Ô]
STRSQL = STRSQL & [Ô] FROM TBL_DETALHE_NUMERO DN INNER JOIN TBL_DESCRICAO D[Ô]
STRSQL = STRSQL & [Ô] ON DN.ID_DESC_DN = D.ID_DESC[Ô]
STRSQL = STRSQL & [Ô] INNER JOIN TBL_CIDADE_CLIENTE CC[Ô]
STRSQL = STRSQL & [Ô] ON D.ID_CC_DESC = CC.ID_CC[Ô]
STRSQL = STRSQL & [Ô] INNER JOIN TBL_CLIENTE C[Ô]
STRSQL = STRSQL & [Ô] ON CC.ID_CLI_CC = C.ID_CLI[Ô]
STRSQL = STRSQL & [Ô] Where[Ô]
STRSQL = STRSQL & [Ô] DN.ID_BD_DN = [Ô] & lblIdBanco.Caption & [Ô] AND DN.DATA_DN LIKE [ô][Ô] & lblData.Caption & [Ô][Ô] & [Ô][ô][Ô]
STRSQL = STRSQL & [Ô] AND D.TIPO_DESC LIKE [ô]CP[ô][Ô]
STRSQL = STRSQL & [Ô] ORDER BY D.POSICAO_DESC[Ô]
rsNh.Open STRSQL, conNh, adOpenStatic, adLockReadOnly
Set Sn = rsNh.Clone
rsNh.Close
stCell.row = 1
stCell.col = 1
Call CopyRecords(Sn, objExlSht, stCell)
Set Sn = Nothing
If UCase(lblBanco.Caption) = [Ô]RIO DE JANEIRO[Ô] Then
[ô]PLANILHA DE E1
Set objExlSht = oExcel.ActiveWorkbook.Sheets(3)
objExlSht.Name = [Ô]ESTUDO E1[Ô]
conNh.Execute [Ô]EXEC USP_LISTAGEM_E1 [Ô]
STRSQL = [Ô]select * from temp1 [Ô]
rsNh.Open STRSQL, conNh, adOpenKeyset, adLockBatchOptimistic
Set Sn = rsNh.Clone
rsNh.Close
Set rsNh = Nothing
stCell.row = 1
stCell.col = 1
Call CopyRecords(Sn, objExlSht, stCell)
Set Sn = Nothing
conNh.Execute [Ô]DROP TABLE TEMP1[Ô]
[ô]VESPERS P1
STRSQL = [Ô] SELECT [Ô]
STRSQL = STRSQL & [Ô] DV.ID_DV AS ID,[Ô]
STRSQL = STRSQL & [Ô] DV.DATA_DV AS DATA,[Ô]
STRSQL = STRSQL & [Ô] DV.NUMERO_DV AS NUMERO,[Ô]
STRSQL = STRSQL & [Ô] DV.DESCRICAO_DV AS DESCRICAO,[Ô]
STRSQL = STRSQL & [Ô] DV.LIG_N_DV AS LIG_N,[Ô]
STRSQL = STRSQL & [Ô] DV.TEMPO_N_DV AS TEMPO_N,[Ô]
STRSQL = STRSQL & [Ô] DV.LIG_R_DV AS LIG_R,[Ô]
STRSQL = STRSQL & [Ô] DV.TEMPO_R_DV AS TEMPO_R,[Ô]
STRSQL = STRSQL & [Ô] ISNULL (V.LOCAL_VESPER,[ô]CAD.PENDENTE[ô])AS LOCAL,[Ô]
STRSQL = STRSQL & [Ô] P.DESCRICAO_PROJ AS PROJETO[Ô]
STRSQL = STRSQL & [Ô] FROM TBL_DETALHE_VESPER DV INNER JOIN TBL_VESPER V[Ô]
STRSQL = STRSQL & [Ô] ON DV.NUMERO_DV = V.NUMERO_VESPER[Ô]
STRSQL = STRSQL & [Ô] INNER JOIN TBL_PROJETO P[Ô]
STRSQL = STRSQL & [Ô] ON DV.ID_PROJ_DV = P.ID_PROJ[Ô]
STRSQL = STRSQL & [Ô] WHERE DATA_DV LIKE [ô][Ô] & lblData.Caption & [Ô][ô] AND ID_PROJ_DV = 1[Ô]
rsNh.Open STRSQL, conNh, adOpenKeyset, adLockBatchOptimistic
Set Sn = rsNh.Clone
rsNh.Close
Set rsNh = Nothing
If Sn.RecordCount > 0 Then
Set objExlSht = oWorkbook.Worksheets.Add
[ô]Set objExlSht = oWorkbook.Worksheets(5)
objExlSht.Name = [Ô]PROJ I[Ô]
contaPlanilha = oWorkbook.Worksheets.Count
objExlSht.Move After:=oWorkbook.Sheets(contaPlanilha)
stCell.row = 1
stCell.col = 1
Call CopyRecords(Sn, objExlSht, stCell)
End If
Set Sn = Nothing
[ô]VESPERS PII
STRSQL = [Ô] SELECT [Ô]
STRSQL = STRSQL & [Ô] DV.ID_DV AS ID,[Ô]
STRSQL = STRSQL & [Ô] DV.DATA_DV AS DATA,[Ô]
STRSQL = STRSQL & [Ô] DV.NUMERO_DV AS NUMERO,[Ô]
STRSQL = STRSQL & [Ô] DV.DESCRICAO_DV AS DESCRICAO,[Ô]
STRSQL = STRSQL & [Ô] DV.LIG_N_DV AS LIG_N,[Ô]
STRSQL = STRSQL & [Ô] DV.TEMPO_N_DV AS TEMPO_N,[Ô]
STRSQL = STRSQL & [Ô] DV.LIG_R_DV AS LIG_R,[Ô]
STRSQL = STRSQL & [Ô] DV.TEMPO_R_DV AS TEMPO_R,[Ô]
STRSQL = STRSQL & [Ô] ISNULL (V.LOCAL_VESPER,[ô]CAD.PENDENTE[ô])AS LOCAL,[Ô]
STRSQL = STRSQL & [Ô] P.DESCRICAO_PROJ AS PROJETO[Ô]
STRSQL = STRSQL & [Ô] FROM TBL_DETALHE_VESPER DV INNER JOIN TBL_VESPER V[Ô]
STRSQL = STRSQL & [Ô] ON DV.NUMERO_DV = V.NUMERO_VESPER[Ô]
STRSQL = STRSQL & [Ô] INNER JOIN TBL_PROJETO P[Ô]
STRSQL = STRSQL & [Ô] ON DV.ID_PROJ_DV = P.ID_PROJ[Ô]
STRSQL = STRSQL & [Ô] WHERE DATA_DV LIKE [ô][Ô] & lblData.Caption & [Ô][ô] AND ID_PROJ_DV = 2[Ô]
rsNh.Open STRSQL, conNh, adOpenKeyset, adLockBatchOptimistic
Set Sn = rsNh.Clone
rsNh.Close
Set rsNh = Nothing
If Sn.RecordCount > 0 Then
Set objExlSht = oWorkbook.Worksheets.Add
contaPlanilha = oWorkbook.Worksheets.Count
objExlSht.Move After:=oWorkbook.Sheets(contaPlanilha)
objExlSht.Name = [Ô]PROJ II[Ô]
stCell.row = 1
stCell.col = 1
Call CopyRecords(Sn, objExlSht, stCell)
End If
Set Sn = Nothing
End If
objExlSht.SaveAs NomeArquivo
objExlSht.Application.Quit
Set objExlSht = Nothing
Set oExcel = Nothing
Set Sn = Nothing
Set Db = Nothing
MousePointer = vbDefault
[ô]MsgBox [Ô]Dados exportados com sucesso.[Ô], vbInformation, [Ô]Nh Telecom[Ô]
Dim Excel As Object
Set Excel = CreateObject([Ô]Excel.Application[Ô])
With Excel
.Workbooks.Open filename:=NomeArquivo
.Visible = True
.Sheets(1).Select
.Range([Ô]A1[Ô]).Select
End With
trata_erro:
If Err.Number = cdlCancel Then
[ô] Usuário pressionou botão Cancelar.
Exit Sub
Else
MousePointer = vbDefault
Set rsNh = Nothing
Set Sn = Nothing
Call trataErro(Err)
End If
End Sub
Colega só mais uma dica, tudo que precisar fazer no excel e não souber basta proceder da seguinte maneira
abra uma planilha excel va em ferramentas / macros e clique em gravar nova macro.
tudo que vc fizer a partir dai estara sendo gravado, então inclua planilha, exclua planilha mude de lugar ou renomeie, ou seja faça manualmente o que deseja que o vb faça automaticamente, depois pare a macro.
va novamente em ferramentas macros, e clique em macros escolha a que vc acabou de criar e clique em edit.
pronto todo código que precisa estará lá.
abraço
abra uma planilha excel va em ferramentas / macros e clique em gravar nova macro.
tudo que vc fizer a partir dai estara sendo gravado, então inclua planilha, exclua planilha mude de lugar ou renomeie, ou seja faça manualmente o que deseja que o vb faça automaticamente, depois pare a macro.
va novamente em ferramentas macros, e clique em macros escolha a que vc acabou de criar e clique em edit.
pronto todo código que precisa estará lá.
abraço
Valeu Marcelão .... essa dica vou deixar anotada aqui, isso é de uma praticidade absurda. .... abraços !!!
Tópico encerrado , respostas não são mais permitidas