Ir para conteúdo
Fórum Script Brasil

Impacto_RJ

Membros
  • Total de itens

    7
  • Registro em

  • Última visita

Sobre Impacto_RJ

Impacto_RJ's Achievements

0

Reputação

  1. Impacto_RJ

    Vb X Excel

    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.
  2. 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
  3. Bom dia a todos, Estou tentando preencher uma msflexgrid (Seria o mais apropriado ??? Com os seguintes dados de uma determinada tabela, segue ex. Id Codigo Nome Dt_Vencimento Valor Dt_Pgto Valor 1 0001 Joao 10/08/2006 50,00 09/08/2006 50,00 2 0001 Joao 10/09/2006 50,00 10/09/2006 50,00 3 0001 Joao 10/10/2006 50,00 10/10/2006 50,00 4 0001 Joao 10/11/2006 50,00 5 0001 Joao 10/12/2006 50,00 e por ai vai.... Eu posso colocar esses dados de modo que cada Data de Vencimento, Valor, Data Pagamento e Pagamento fossem colocados em colunas como por ex. Id Codigo Nome 1º Venc Valor Dt_Pgto Valor 2º Venc. Valor Dt_Pgto Valor 1 0001 Joao 10/08/2006 50,00 09/08/2006 50,00 10/09/2006 50,00 10/09/2006 50,00 e assim por diante... Desde já agradeço....
  4. Galera, bom dia... Um amigo meu possui uma placa antiga FIC VA503+ e estava atualizando sua BIOS....para reconhecimento de um novo HD que comprou 120 GB. Ele utilizou o programa Flash703.exe e quando o programa estava fazendo o back-up da BIOS anterior, ele pensou que o micro travou e desligou o mesmo. O que aconteceu ?? Danou-se não liga nada. Teria algum jeito de recuperar a BIOS da placa dele ??? Quem souber PF Desde já agradeço.
  5. Bom dia, com a string "SELECT * FROM TABELA WHERE Empresa = '" & w_empresa & "'" funcionou ok. Com esta "SELECT * FROM TABELA WHERE Empresa = '" & w_empresa.Text & "' And Data = #" & Format(msk_dtMov.Text, "YYYY-MM-DD") & "#" , aparece a mensagem 13-Type Mismatch.
  6. Sim, porque quando eu digito o nome da empresa em w_empresa e a data do Movimento em msk_dtmov, eu abro uma listbox e o sistema filtra direito e joga os registros na listbox....
  7. Galera bom dia... sou mais um iniciante em Visual Basic... Estou desenvolvendo um sistema mas estou enpacado num relatório. Uso DataEnvironment, fiz a conexão ok, Fiz o Command usando a linha de Comando SELECT * FROM TABELA ORDER BY Empresa, aí o relatório traz todos os Campos da Base ....Ok. Quando eu mudo a linha de comando para SELECT * FROM TABELA WHERE Empresa = '" & w_empresa & "' não aparece nada. Gostaria se possível emitir esse relátorio filtrando os campos Empresa e Data do Movimento. Os objetos no Form são w_empresa para Empresa e msk_dtMov para Data Movimento. Desde já agradeço a ajuda....
×
×
  • Criar Novo...