Ir para conteúdo
Fórum Script Brasil

Weslley Oliveira

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Tudo que Weslley Oliveira postou

  1. Bom dia! Tenho dois formulários sendo um para cadastro e outro para pesquisa. Tudo deu certo com o formulário de cadastro (segue o código): Private Sub bt_CadEqOk_Click() Dim linha As Integer linha = Sheet1.Range("A65536").End(xlUp).Offset(1, 0).Row Sheet1.Range("B" & linha).Value = tb_NomeTecnico.Text Sheet1.Range("C" & linha).Value = tb_Modelo.Text Sheet1.Range("D" & linha).Value = cb_Local.Text Sheet1.Range("T" & linha).Value = cb_EmpresaResponsavel.Text Sheet1.Range("F" & linha).Value = tb_NumeroDeSerie.Text Sheet1.Range("G" & linha).Value = tb_Fabricante.Text Sheet1.Range("H" & linha).Value = tb_RegAnvisa.Text Sheet1.Range("I" & linha).Value = tb_DataDaInstalacao.Text Sheet1.Range("J" & linha).Value = tb_DataDaCompraContrato.Text Sheet1.Range("K" & linha).Value = tb_ValorCompraContrato.Text Sheet1.Range("L" & linha).Value = tb_ParcelasTempoDeContrato.Text Sheet1.Range("N" & linha).Value = tb_TempoDeGarantia.Text Sheet1.Range("O" & linha).Value = tb_PeriodicidadeDaMP.Text Sheets("Configuração").Select Range("E4").Select Selection.Copy Sheets("DBEQ").Select Range("tb_dbeq[Número de Patrimônio]").Select 'Procura Célula Vazia Do If Not (IsEmpty(ActiveCell)) Then ActiveCell.Offset(1, 0).Select End If Loop Until IsEmpty(ActiveCell) = True Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False MsgBox "Cadastrado com sucesso...", 64, "Dados" Me.tb_NomeTecnico = "" '_______Avança PATRIMÔNIO______ [Configuração!E3] = [Configuração!E3] + 1 Unload Me End Sub Parti para a etapa do formulário de pesquisa e ele também funcionou incrivelmente bem (Segue o código): Private Sub bt_limpapesquisa_Click() ActiveSheet.ShowAllData ListView1.ListItems.Clear Sheets("DBEQ").Select lin = 2 Do If Cells(lin, 1).Rows.Hidden = False Then Set li = ListView1.ListItems.Add(Text:=Sheets("DBEQ").Cells(lin, 1).Value) li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 6).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 3).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 4).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 9).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 16).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 17).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 20).Value End If lin = lin + 1 Loop Until Sheets("DBEQ").Cells(lin, 1) = "" End Sub Private Sub bt_pesqEq_Click() ActiveSheet.ListObjects("tb_dbeq").Range.AutoFilter Field:=1, Criteria1:="=*" & Me.txt_equipamento.Value & "*" ListView1.ListItems.Clear Sheets("DBEQ").Select lin = 2 Do If Cells(lin, 1).Rows.Hidden = False Then Set li = ListView1.ListItems.Add(Text:=Sheets("DBEQ").Cells(lin, 1).Value) li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 6).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 3).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 4).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 9).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 16).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 17).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 20).Value End If lin = lin + 1 Loop Until Sheets("DBEQ").Cells(lin, 1) = "" End Sub Private Sub UserForm_Initialize() With ListView1 .BorderStyle = ccFixedSingle .Gridlines = True .View = lvwReport .FullRowSelect = True .ColumnHeaders.Add Text:="Equipamento", Width:=160 .ColumnHeaders.Add Text:="Número de Série", Width:=80, Alignment:=2 .ColumnHeaders.Add Text:="Modelo", Width:=75, Alignment:=2 .ColumnHeaders.Add Text:="Local da Instalação", Width:=100, Alignment:=2 .ColumnHeaders.Add Text:="Data da Instalação", Width:=80, Alignment:=2 .ColumnHeaders.Add Text:="Data da Última OS", Width:=80, Alignment:=2 .ColumnHeaders.Add Text:="Motivo da Última OS", Width:=100, Alignment:=2 .ColumnHeaders.Add Text:="Empresa Responsável", Width:=90, Alignment:=2 End With ListView1.ListItems.Clear Sheets("DBEQ").Select lin = 2 Do Until Sheets("DBEQ").Cells(lin, 1) = "" Set li = ListView1.ListItems.Add(Text:=Sheets("DBEQ").Cells(lin, 1).Value) li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 6).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 3).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 4).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 9).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 16).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 17).Value li.ListSubItems.Add Text:=Sheets("DBEQ").Cells(lin, 20).Value lin = lin + 1 Loop End Sub O problema é que, após criar e testar o formulário de pesquisa, voltei a testar o formulário de cadastro e o mesmo parou de funcionar. Sempre que clico no botão "ok" para cadastrar, o excel crasha e no debug eu recebo "Automation error". Quando altero a linha para Long (ao invés de integer), recebo a mensagem de method "value" of object "range" fail. Eu removi o form de pesquisa e o form de cadastro voltou a funcionar. Alguém teria alguma ideia do que pode ser? Grato!
×
×
  • Criar Novo...