Abrir Planilha do Excel usando VBA

[Bela 0]

Abrir planilha no excel com VBA

Mensagem : Olá!

 

Estou abrindo uma planilha no excel através de um formulário mas dá o seguinte erro:

Erro em tempo de execução '13' tipos incompatíveis. O código segue abaixo.

 

Dim db As Database

Dim rs As Recordset

Set db = OpenDatabase("C:\ s and Settings\izabel\Meus os\litombo.xls", False, False, "excel 8.0")

Set rs = db.OpenRecordset("Plan1$", dbOpenDynaset)-> "Erro acontece aqui"

While rs.EOF = False

If grade1.Row = grade1.Rows - 1 Then

grade1.Rows = grade1.Rows + 1

End If

 

grade1.Row = grade1.Row + 1

grade1.Col = 0

grade1.Text = rs("Número")

grade1.Col = 1

grade1.Text = rs("Volume")

rs.MoveNext

Wend

[mibnetweb 0]

Olá Bela!

 

O caminho indicado na linha abaixo está correto?

Set db = OpenDatabase("C:\ s and Settings\izabel\Meus os\litombo.xls", False, False, "excel 8.0")

[Jattobá 0]

Abrir planilha no excel com VBA

Mensagem : Olá!

 

Estou abrindo uma planilha no excel através de um formulário mas dá o seguinte erro:

Erro em tempo de execução '13' tipos incompatíveis. O código segue abaixo.

 

Dim db As Database

Dim rs As Recordset

Set db = OpenDatabase("C:\ s and Settings\izabel\Meus os\litombo.xls", False, False, "excel 8.0")

Set rs = db.OpenRecordset("Plan1$", dbOpenDynaset)-> "Erro acontece aqui"

While rs.EOF = False

If grade1.Row = grade1.Rows - 1 Then

grade1.Rows = grade1.Rows + 1

End If

 

grade1.Row = grade1.Row + 1

grade1.Col = 0

grade1.Text = rs("Número")

grade1.Col = 1

grade1.Text = rs("Volume")

rs.MoveNext

Wend

 

 

Se você estiver usando em um sistema access(VBA).

1) Vá até a qualquer codificação e no menu "Ferramentas" do VBA e escolha "Referencias" e procure e ative "Microsoft Excel 9.0 Object Library".

2) Eu uso a função abaixo.

 

 

'Criar a lista de dados, e repassar para a função ChamaExcel

'----------------------------------------------------------------------

Private Sub PlanAreas_Click()

sSQL = "SELECT idtrt AS ID ,Descricao as Descrição FROM TBLtrt"

sSQL = sSQL & " ORDER BY idtrt"

Call ChamaExcel(sSQL) '--------------Passa a lista de dados e repassa para o excel.

End Sub

 

 

'Coloco a função abaixo em um módulo

'---------------------------------------------

Option Compare Database

Dim cnn As ADODB.Connection

 

Public Function ChamaExcel(SqlTexto As String)

Dim I As Long, n As Long, col As Long, lin As Long

Dim objExcel As Excel.Application

Dim objWorkbook As Excel.Workbook

 

On Error GoTo erro

 

Dim rsPlan As ADODB.Recordset

Set rsPlan = New ADODB.Recordset

Set rsPlan = AbrirRecordSetADOsql(SqlTexto, cnn, adOpenForwardOnly, , adLockReadOnly, adCmdText)

 

If Not rsPlan.EOF Then

 

Set objExcel = New Excel.Application

Set objExcel = GetObject(, "Excel.Application")

 

If Err.Number Then

Err.Clear

Set objExcel = CreateObject("Excel.Application")

If Err.Number Then

MsgBox "Não foi possivel abrir o Excel."

End If

End If

 

objExcel.Visible = True

Set objWorkbook = objExcel.Workbooks.Add

 

'--- conta as linhas ---

Do While Not rsPlan.EOF

lin = lin + 1

rsPlan.MoveNext

Loop

 

'--- conta as colunas ---

col = rsPlan.Fields.Count

 

For I = 0 To 0

For n = 0 To col - 1

objWorkbook.ActiveSheet.Cells(I + 1, n + 1).value = rsPlan.Fields(n).Name

Next

Next

 

rsPlan.MoveFirst ' move para o primeiro registro

For I = 1 To lin

For n = 0 To col - 1

objWorkbook.ActiveSheet.Cells(I + 1, n + 1).value = rsPlan.Fields(n).value

Next

rsPlan.MoveNext

Next

 

Else

 

MsgBox "Não existe dados para exportar ao Excel !", vbInformation, "Aviso"

 

End If

 

rsPlan.Close

Set objWorkbook = Nothing

Set objExcel = Nothing

Set rsPlan = Nothing

 

erro:

 

Dim Msg

If Err.Number <> 0 Then

Msg = "Err # " & Str(Err.Number) & " was generated by " _

& Err.Source & Chr(13) & Err.Description

MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext

Err.Clear

End If

End Function