Jump to content
Fórum Script Brasil
  • 0

Vb X Excel


Impacto_RJ
 Share

Question

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

Link to comment
Share on other sites

3 answers to this question

Recommended Posts

  • 0

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

Link to comment
Share on other sites

  • 0

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.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share



  • Forum Statistics

    • Total Topics
      151k
    • Total Posts
      649k
×
×
  • Create New...