Usamos cookies para medir audiência e melhorar sua experiência. Você pode aceitar ou recusar a qualquer momento. Veja sobre o iMasters.
Fala galera,
To com duvidas sobre macros do excel no vb6....
Tipo:
1 - Como rodar uma macro criada em excel em cima de um arquivo que eu venha a escolher (nome gravado em variavel), direto do VB6? Eu já copiei a rotina da macro para o VB mas preciso saber como direcioná-la para um determinado arquivo...
2 - Qdo eu mando exportar os registros de uma consulta no SQL Server para um arquivo excel ele fica criando juntamente com o meu arquivo um arquivo genérico vazio (ex: pasta1.xls).... isso é normal? O código está abaixo.. q q erro, por favor me ajudem!
abs!
'Rotinas de criação, abertura, gravação e fechamento do arquivo excel.'Lembrar de adicionar as referencias ao excel no projeto.Private Sub cria_xls()If flag_excel = True Then Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add Set cotacao = xlBook.Worksheets(1) 'designa Cotacao como a pasta de trabalho 1 do arquivo a ser criado.Else Exit SubEnd IfEnd SubPrivate Sub abre_xls(arquivo)If flag_excel = True Then Set xlBook = GetObject(Dir & "\" & arquivo) Set cotacao = xlBook.Worksheets(1)Else Exit SubEnd IfEnd SubPrivate Sub ApagaSalvaFecha_xls()If flag_excel = True Then xlBook.Save Set cotacao = Nothing Set xlBook = NothingElse Exit SubEnd IfEnd SubPrivate Sub SalvaFecha_xls(strArqEmail)If flag_excel = True Then Dim fContinue Dim objScript fContinue = False Set objScript = CreateObject("Scripting.FileSystemObject") fContinue = objScript.FileExists(strArqEmail) Set objScript = Nothing On Error GoTo AA xlBook.SaveAs strArqEmail AA: If Err Then If fContinue Then Kill strArqEmail Exit Sub Else MsgBox "Ocorreu um erro ao gravar o arquivo. Certifique-se que ele não esteja aberto ou sendo usado por outra aplicação", vbCritical flag_excel = False Kill strArqEmail Exit Sub End If End If xlApp.Quit Set cotacao = Nothing Set xlBook = Nothing Set xlApp = NothingElse Exit SubEnd IfEnd SubPrivate Sub salva_xls()If flag_excel = True Then Dim i As Integer Dim Com As New ADODB.Command Dim rst As New ADODB.Recordset Dim sql As String Dim data As String Dim situacao As String If Not flag_excel = False Then If rst.State = adStateOpen Then rst.Close End If sql = "" sql = v_comando Com.CommandType = adCmdText Com.CommandText = sql Set Com.ActiveConnection = form_login.conexao rst.Open Com, , adOpenDynamic, adLockOptimistic Call cria_xls 'Cuentas con un Recorset llamado RST proveniente de una Consulta hecha previamente. i = 3 'ALIMENTA A PARTE FIXA data = "" data = "UPDATED: " If Format(rst.Fields("dt_envio").Value, "MM") = 1 Then data = data & "JANUARY " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 2 Then data = data & "FEBRUARY " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 3 Then data = data & "MARCH " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 4 Then data = data & "APRIL " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 5 Then data = data & "MAY " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 6 Then data = data & "JUNE" data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 7 Then data = data & "JULY " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 8 Then data = data & "AUGUST " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 9 Then data = data & "SEPTEMBER " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 10 Then data = data & "OCTOBER " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 11 Then data = data & "NOVEMBER " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") ElseIf Format(rst.Fields("dt_envio").Value, "MM") = 12 Then data = data & "DECEMBER " data = data & Format(rst.Fields("dt_envio").Value, "DD") & "th, " data = data & Format(rst.Fields("dt_envio").Value, "YYYY") End If cotacao.Cells(1, 2) = data cotacao.Cells(2, 1) = "GMID" cotacao.Cells(2, 2) = "DESCRIPTION" cotacao.Cells(2, 3) = "APROVED/DAICOLOR" cotacao.Cells(2, 5) = "DAICOLOR CODE" cotacao.Cells(rst.RecordCount + 4, 1) = "Condição de Pagamento:" cotacao.Cells(rst.RecordCount + 5, 1) = rst.Fields("obs_cond_pgto").Value 'ALIMENTA A PARTE VARIÁVEL Do While rst.EOF = False 'Os campos são referenciais (linha i, Coluna 1 o A, celula 1 ) cotacao.Cells(i, 1) = rst.Fields("cod_mat2").Value cotacao.Cells(i, 2) = rst.Fields("cod_mat1").Value situacao = "" If UCase(rst.Fields("nome_situacao").Value) = "ATIVO" Then situacao = "Active" ElseIf UCase(rst.Fields("nome_situacao").Value) = "DESATIVADO" Then situacao = "Inactive" End If cotacao.Cells(i, 3) = situacao cotacao.Cells(i, 4) = "R$ " & rst.Fields("preco_unit").Value cotacao.Cells(i, 5) = rst.Fields("descr_mat").Value 'Contador para las lineas de Excel. i = i + 1 rst.MoveNext Loop Call ajusta_cotacao SalvaFecha_xls strArqEmail End IfElse Exit SubEnd IfEnd Sub
Carregando comentários...
