Ir para conteúdo
Fórum Script Brasil
  • 0

Vb X Excel


Impacto_RJ

Pergunta

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 para o comentário
Compartilhar em outros sites

3 respostass a esta questão

Posts Recomendados

  • 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 para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,7k
×
×
  • Criar Novo...