Macros de Excel em VB6

[overload 0]

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

[Graymalkin 0]

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...

Se não me engano, você tem que abrir o arquivo (com o WorkBooks.Open) e depois executar a macro com o método Run.Abraços,Graymalkin

[overload 0]

Valeu... Mas você poderia detalhara rotina, pois aqui nao estou conseguindo...Abs!

[Graymalkin 0]

Valeu...

 

Mas você poderia detalhara rotina, pois aqui nao estou conseguindo...

 

Abs!

<{POST_SNAPBACK}>

Basicamente é isso:

 

   Dim x As Object        Set x = CreateObject("Excel.Application") 'Cria o objeto do Excel    x.Workbooks.Open "c:\temp\pasta1.xls" 'Abre o arquivo    x.Visible = True 'Torna o Excel visível    x.Run "Macro1" 'Executa a "Macro1"

Certo? ;)

 

Graymalkin