Vb X Excel

[Impacto_RJ]

Boa noite a todos,

Estou desenvolvendo uma rotina em que uma consulta deverá gerar uma planilha no excel...

Quando a executo pela 1ª vez, ok.

O excel gera a planilha formatada ok.

Mas quando fecho o excel e executo a rotina novamente, aparece a seguinte mensagem.

Run Time error 91

Object variable or with block variable not set.

O Excel abre e no topo da tela aparece a Pasta 4, que estou deixando de fazer ??

As variáveis foram definidas e no final da rotina eu as elimino da memória.

desde já agradeço....

JL

[Graymalkin]

Seria melhor você mostrar o código usado. Mas, se você destrói o objeto Excel ao final do procedimento, você tem absoluta certeza de que você o cria ao iniciar o procedimento? Ou você o cria em outro local e está se esquecendo disso?

Abraços,

Graymalkin

[Impacto_RJ]

O codigo seria assim

Option Explicit

Dim oExcel As Object

Dim objExlSht As Object

Private Type ExlCell

row As Long

Col As Long

End Type

-------------------------------------

Private Sub cmd_Excel_Click()

Dim objExlSht As Object

Dim stCell As ExlCell

MousePointer = vbHourglass ' Muda o ponteiro do mouse

Set oExcel = CreateObject("Excel.Application")

oExcel.Workbooks.Add 'inclui o workbook

Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)

rs_Boletas_Lidas.MoveFirst

' Inclui os dados a partir da celula A9

stCell.row = 9

stCell.Col = 1

oExcel.Visible = True

oExcel.Cells.Select 'Formata as células para Verdana 8

With Selection.Font

.Name = "Verdana"

.Size = 8

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

oExcel.Range("a2").Select

oExcel.Range("a2") = "Empresas Reunidas JLP"

oExcel.Range("b2").Select

oExcel.Range("b2") = "Posição do Contrato: " & w_NumContr & " - " & w_NomeContr & " em " & Date

oExcel.Range("b3") = w_Obs1

oExcel.Range("b4") = w_Obs2

oExcel.Range("b5") = w_Obs3

oExcel.Range("b6") = w_Obs4

oExcel.Range("b7") = w_Obs5

oExcel.Range("a2").Select ' Formata a coluna A

Selection.ColumnWidth = 40

With Selection.Font

.Name = "Verdana"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

' Chama a Função

CopiarTabelaExcel rs_Boletas_Lidas, objExlSht, stCell

' Salva a planilha

objExlSht.SaveAs App.Path & "\Excel\" & Mid(w_NumContr, 1, 3) & Day(Date) & Month(Date) & ".xls"

MsgBox "Planilha em Excel gerada!!!", vbInformation, "Manutenção de Boletas"

objExlSht.Application.Quit

Set objExlSht = Nothing ' remove a variavel objeto

Set oExcel = Nothing ' remove a variavel objeto

MousePointer = vbDefault

cmd_Excel.Enabled = False

End Sub

Private Sub CopiarTabelaExcel(rs As Recordset, ws As Worksheet, StartingCell As ExlCell)

Dim Vetor() As Variant

Dim row As Long, Col As Long

Dim fd As Field

rs_Boletas_Lidas.MoveLast

ReDim Vetor(rs_Boletas_Lidas.RecordCount + 1, I_parcelas)

' Copia as colunas do cabecalho para um vetor

Vetor(row, Col) = "Nome / Vencimento"

Col = Col + 1

dia = Val(Mid(d_Inicio, 1, 2))

mês = Val(Mid(d_Inicio, 4, 2))

ano = Val(Mid(d_Inicio, 7, 4))

row = 1

For JJ = 0 To I_parcelas - 1

Vetor(0, Col) = Format(d_Inicio, "dd/mm/yyyy")

Col = Col + 1

mês = mês + 1

If mês > 12 Then

mês = 1

ano = ano + 1

End If

'Verificando o mês de fevereiro

If (mês = 2) Then

If (dia >= 30) Then

s_Data = "28" & "/" & Str(mês) & "/" & Str(ano)

End If

fevereiro = ano Mod 4

If (fevereiro <> 0) And (dia = 29) Then

s_Data = "28" & "/" & Str(mês) & "/" & Str(ano)

End If

Else

s_Data = Str(dia) & "/" & Str(mês) & "/" & Str(ano)

End If

d_Inicio = s_Data

Next

' copia o recordset para um vetor

rs_Boletas_Lidas.MoveFirst

Col = 0

Do While Not rs_Boletas_Lidas.EOF

w_Aluno = rs_Boletas_Lidas!N_Aluno

Vetor(row, Col) = rs_Boletas_Lidas!N_Aluno

Col = Col + 1

Do While w_Aluno = rs_Boletas_Lidas!N_Aluno

If rs_Boletas_Lidas!Ocorrencia = "99" Then

Vetor(row, Col) = " Cancelado "

ElseIf rs_Boletas_Lidas!Ocorrencia = "03" Then

Vetor(row, Col) = " Rejeitado "

Else

Vetor(row, Col) = IIf(IsNull(rs_Boletas_Lidas!Valor_Pg), " Não Pago ", rs_Boletas_Lidas!Valor_Pg)

End If

' Vetor(row, Col) = IIf(IsNull(rs_Boletas_Lidas!DT_Vencimento), " Não Pago ", Format(rs_Boletas_Lidas!DT_Vencimento, "dd/mm/yyyy"))

Col = Col + 1

rs_Boletas_Lidas.MoveNext

If rs_Boletas_Lidas.EOF Then

Exit Do

End If

Loop

Col = 0

row = row + 1

Loop

ws.Range(ws.Cells(StartingCell.row, StartingCell.Col), ws.Cells(StartingCell.row + rs.RecordCount + 1, _

StartingCell.Col + rs.Fields.Count)).Value = Vetor

oExcel.Range("b9").Select ' Formata a Linha do Cabecalho

oExcel.Range(Selection, Selection.End(xlToRight)).Select

oExcel.Selection.ColumnWidth = 13

oExcel.Range("a9").Select

oExcel.Range(Selection, Selection.End(xlToRight)).Select

oExcel.Selection.Font.Bold = True

oExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone

oExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone

oExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

oExcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone

oExcel.Selection.Borders(xlInsideVertical).LineStyle = xlNone

oExcel.ActiveWindow.DisplayGridlines = False

If oExcel.Range("a11") = Null Then

oExcel.Range("b10").Select

oExcel.Range(Selection, Selection.End(xlToRight)).Select

Else

oExcel.Range("b10").Select

oExcel.Range(Selection, Selection.End(xlDown)).Select

oExcel.Range(Selection, Selection.End(xlToRight)).Select

End If

With Selection

.HorizontalAlignment = xlRight

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

If oExcel.Range("a11") = Null Then

oExcel.Range("A10").Select

Else

oExcel.Range("A10").Select

oExcel.Selection.End(xlDown).Select

End If

oExcel.Range(Selection, Selection.End(xlToRight)).Select

oExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone

oExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone

oExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone

oExcel.Selection.Borders(xlEdgeTop).LineStyle = xlNone

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

oExcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone

oExcel.Selection.Borders(xlInsideVertical).LineStyle = xlNone

With ActiveSheet.PageSetup 'Formata Impressao

.PrintTitleRows = ""

.PrintTitleColumns = "$A:$A"

End With

oExcel.ActiveSheet.PageSetup.PrintArea = ""

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = Application.InchesToPoints(0.196850393700787)

.RightMargin = Application.InchesToPoints(0.196850393700787)

.TopMargin = Application.InchesToPoints(0.393700787401575)

.BottomMargin = Application.InchesToPoints(0.393700787401575)

.HeaderMargin = Application.InchesToPoints(0.511811023622047)

.FooterMargin = Application.InchesToPoints(0.511811023622047)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintNoComments

.PrintQuality = -4

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperA4

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = 100

.PrintErrors = xlPrintErrorsDisplayed

End With

End Sub

Como disse quando clico no botão cmd_Excel na primeira vez, a rotina está OK.....

mas quando o excel é fechado e clico novamente, aparece o referido erro.

[Graymalkin]

Em qual linha ocorre o erro? E note que você declarou objExlSht duas vezes (uma vez na seção General Declarations e outra no procedimento).

Abraços,

Graymalkin