Home Excel - Dicas Microsoft Excel VBA Excel VBA - Userforms e outros Excel planilha vba textboxes datas e numeros verifica inconsistencia

Excel planilha vba textboxes datas e numeros verifica inconsistencia

Ter, 30 de Outubro de 2012 07:26 Expedito Marcondes
E-mail Imprimir PDF

Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

Prezada Amiga Luciana,
Observe o que voce deverá fazer em seu projeto, aqui fiz alguns códigos para seus procedimentos
fiz apenas para 25 objetos textboxes, que retornaram dados para sua folha de planilha, carrega listboxes ao abrir o userform, limpa todas as textboxes para uma nova ação baseados nos objetos existentes usando a instrução For Next e Controls para todos os objetos Textboxes.
você deverá completar o restante ok...
Depois, terminado o seu projeto,  envie-me para verificar Ok.....
Fique com Deus, bons estudos.
'//- - - - - - - - - - - - - - - - - - - - '
Expedito Marcondes - Escola Saberexcel VBA Estudos.    - [email protected]
Curso completo MS Excel VBA     >>> Curso Completo Microsoft Excel VBA
'//- - - - - - - - - - - - - - - - - - - - '

'//=========='Erro: Me.Controls("TextBox" & x).Value = Sheets("Banco_dados").Range("C" & i + 2).Offset(1,0)

 
Private Sub CommandButton2_Click()
 Dim i As Long
'// ==========' verfica inconsistencia na textbox1 e textbox2
 If txtNOME = "" Then
   If txtSOBRENOME = "" Then
      MsgBox "por favor digite seu nome e sobrenome txtNOME e txtSOBRENOME!!", vbCritical, "Escola Saberexcel VBA Estudos®"
   Exit Sub
   End If
End If
 

'//==========' aumente a performance da execução usando os alertas
 With Application
 .Calculation = xlCalculationManual
 .DisplayAlerts = False
 .ScreenUpdating = False
 End With
 '//========' se entrar e selecionar, salvar o nome selecionado
 For i = 1 To ListBox1.ListCount
   If ListBox1.Selected(i) = True Then
      With Worksheets("Banco_dados").Range("C" & i + 1)
       If TextBox1.Value = "" Then .Offset(1, 0).Value = TextBox2.Value Else .Offset(1, 0).Value = TextBox1.Value
          .Offset(1, 1).Value = TextBox2.Value
          .Offset(1, 1).Value = TextBox2.Value
          .Offset(1, 2).Value = TextBox3.Value
          .Offset(1, 3).Value = TextBox4.Value
          .Offset(1, 5).Value = TextBox5.Value
          .Offset(1, 6).Value = TextBox6.Value
          .Offset(1, 13).Value = TextBox7.Value
          .Offset(1, 14).Value = TextBox8.Value
          .Offset(1, 21).Value = TextBox9.Value
          .Offset(1, 22).Value = TextBox10.Value
          .Offset(1, 29).Value = TextBox11.Value
          .Offset(1, 30).Value = TextBox12.Value
          .Offset(1, 37).Value = TextBox13.Value
          .Offset(1, 38).Value = TextBox14.Value
          .Offset(1, 45).Value = TextBox15.Value
          .Offset(1, 46).Value = TextBox16.Value
          .Offset(1, 53).Value = TextBox17.Value
          .Offset(1, 54).Value = TextBox18.Value
          .Offset(1, 61).Value = TextBox19.Value
          .Offset(1, 62).Value = TextBox20.Value
          .Offset(1, 69).Value = TextBox21.Value
          .Offset(1, 70).Value = TextBox22.Value
          .Offset(1, 77).Value = TextBox23.Value
          .Offset(1, 78).Value = TextBox24.Value
          .Offset(1, 7).Value = TextBox25.Value
       End With
 Textboxes_Branco
 End If
 
Next i
 With Worksheets("Banco_dados").Range("C3").End(xlDown)
   If TextBox1.Value = "" Then .Offset(1, 0).Value = TextBox2.Value Else .Offset(1, 0).Value = TextBox1.Value
      .Offset(1, 1).Value = TextBox2.Value
      .Offset(1, 2).Value = TextBox3.Value
      .Offset(1, 3).Value = TextBox4.Value
      .Offset(1, 5).Value = TextBox5.Value
      .Offset(1, 6).Value = TextBox6.Value
      .Offset(1, 13).Value = TextBox7.Value
      .Offset(1, 14).Value = TextBox8.Value
      .Offset(1, 21).Value = TextBox9.Value
      .Offset(1, 22).Value = TextBox10.Value
      .Offset(1, 29).Value = TextBox11.Value
      .Offset(1, 30).Value = TextBox12.Value
      .Offset(1, 37).Value = TextBox13.Value
      .Offset(1, 38).Value = TextBox14.Value
      .Offset(1, 45).Value = TextBox15.Value
      .Offset(1, 46).Value = TextBox16.Value
      .Offset(1, 53).Value = TextBox17.Value
      .Offset(1, 54).Value = TextBox18.Value
      .Offset(1, 61).Value = TextBox19.Value
      .Offset(1, 62).Value = TextBox20.Value
      .Offset(1, 69).Value = TextBox21.Value
      .Offset(1, 70).Value = TextBox22.Value
      .Offset(1, 77).Value = TextBox23.Value
      .Offset(1, 78).Value = TextBox24.Value
      .Offset(1, 7).Value = TextBox25.Value
   
 End With
 

ActiveWorkbook.Worksheets("Banco_Dados").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Banco_Dados").Sort.SortFields.Add Key:=Range("C3:C2072"), _
 SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 
 With ActiveWorkbook.Worksheets("Banco_Dados").Sort
 .SetRange Range("A3:W2072")
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 

ActiveWorkbook.Save
 
With Application
 .Calculation = xlCalculationAutomatic
 .DisplayAlerts = True
 .ScreenUpdating = True
 End With
 
 Inicialize_ListBox
 Textboxes_Branco
 
End Sub
 
Private Sub CommandButton25_Click()
 ActiveWorkbook.Save
 End Sub
 
Private Sub CommandButton3_Click()
 Unload UserForm1
End Sub
 
Private Sub CommandButton4_Click()
 Worksheets("Banco_dados").Select
 UserForm1.Hide
 End Sub
 '//====== Luciana veja onde voce errou ((<<< temos que chamar os macros neste Botão >>> )) Ok. fique com Deus.
Private Sub CommandButton5_Click()
 Inicialize_ListBox
 Textboxes_Branco
End Sub
 
Private Sub ListBox1_Change()
 Dim i As Long
 Dim x As Byte
 
With ListBox1
 If .ListIndex = -1 Then Exit Sub
 For i = 1 To ListBox1.ListCount
 If .ListCount <= 2 Then Exit Sub
 If .Selected(i) = True Then

 TextBox1.Value = Sheets("Banco_Dados").Range("C" & i + 2).Offset(0, 0).Value
 TextBox2.Value = Sheets("Banco_Dados").Range("C" & i + 2).Offset(0, 1).Value
 TextBox3.Value = Sheets("Banco_Dados").Range("C" & i + 2).Offset(0, 2).Value
 TextBox4.Value = Sheets("Banco_Dados").Range("C" & i + 2).Offset(0, 3).Value

'//======' veja que aqui fiz uma Instrução Loop usando (For Next) para referenciar a todos os seus Objetos TextBoxes  
For x = 5 To 85
 Me.Controls("TextBox" & x).Value = Sheets("Banco_Dados").Range("C" & i + 2).Offset(0, x).Value
 Next x
 .Selected(i) = True
 End If

 Next i
 End With
 
End Sub
 
Private Sub Deletar_Click()
 Dim i As Long
 Application.ScreenUpdating = False
 With ListBox1
   If .ListIndex = -1 Then Exit Sub
     For i = 1 To ListBox1.ListCount
         If .ListCount <= 2 Then Exit Sub
           If .Selected(i) = True Then
               Sheets("Banco_dados").Cells(i + 2, 1).EntireRow.Delete
              .Selected(i) = False
           End If
        Next i
 End With
 Application.ScreenUpdating = True
'//==========' chamando os macros novamente
  Inicialize_ListBox
  TextBoxes_Banco
 End Sub
'//==========' uma espécie de Verifica Inconsistencia se for digitado números: 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 If TextBox1 = "" Then Exit Sub
    If IsNumeric(TextBox1.Text) Then
       MsgBox "Não digite Números somente Textos, porque serão apagados!!", vbCritical, "Escola Saberexcel VBA Estudos®!"
       TextBox1.Value = ""
    Exit Sub
 End If
 meuTexto = TextBox2.Text
 Me.TextBox1 = Format(TextBox1, "")
End Sub

'//==========' uma espécie de Verifica Inconsistencia se for digitado data
Private Sub TextBox22_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 If TextBox22 = "" Then Exit Sub
    Me.TextBox22 = Format(TextBox42, "##"".""##"".""####")
   If Not IsDate(TextBox22.Text) Then
      MsgBox "Digite Data válida, outras itens serão apagados!!!", vbCritical, "Escola Saberexcel VBA Estudos®!"
      TextBox22.Value = ""
   Exit Sub
   End If
End Sub
'//==========' Também um '[Verifica Inconsistencia]' caso deixe em branco força usuario a preencher  
Private Sub TextBox23_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 If TextBox23 = "" Then Exit Sub
    meuTexto = TextBox23.Text
    Me.TextBox23 = Format(TextBox23, "")
 End Sub
'//==========' ao inicializar o userform, carrega o objeto ListBox(Caixa de Listagem)  e Limpa todos as TextBoxes(Caixa de Texto)
Private Sub UserForm_Initialize()
 Inicialize_ListBox
 Textboxes_Branco
 End Sub

'//==========' aqui usei esse procedimento para localizar a ultima linha e carregar o objeto ListBox(Caixa de Listagem) ao abrir Userform
Private Sub Inicialize_ListBox()
 Dim c As Range
 Dim x As Byte
 Dim Ultima_Linha As Long
 
 Me.ListBox1.Clear
 
 Ultima_Linha = Sheets("Banco_dados").Range("C3").End(xlDown).Row
 x = 0
 
For Each c In Sheets("Banco_dados").Range("C2:C" & Ultima_Linha)
 With ListBox1
 .AddItem c
 .List(x, 0) = c
 .List(x, 1) = c.Offset(0, 1)
 x = x + 1
 End With
Next c
 
End Sub
'//==========' aqui esse macro referncia a todos os objetos TextBox(caixa de Texto) -- para limpá-los, deletá-los etc...
Private Sub Textboxes_Branco()
Dim objControl As Control
 For Each objControl In UserForm1.Controls
   If TypeOf objControl Is MSForms.TextBox Then
      objControl.Text = ""
   End If
 Next
End Sub
'//==========' <<< SUA ATENÇÃO PARA DETALHES  SIMPLES, MAS SÃO FUNDAMENTAIS >>>>>

'//==========' um verfifica inconsistencia usando a operador logico "AND" = "E"
'digite
' If TextBox1 = "" And TextBox2 = "" Then
'    MsgBox "digite algo nas textbox1 e textbox2 - SBX !!", vbCritical,"Escola Saberexcel VBA Estudos®"
' Exit Sub
' End If
'
' For i = 1 To ListBox1.ListCount
' (substitua por essa linha Ok )
' For i = 0 To ListBox1.ListCount - 1
 '------------'


Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos
Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.



Tags:
 

Adicionar comentário

"Jamais considere seus estudos como uma obrigação, mas como uma oportunidade invejável para aprender a conhecer a influência libertadora da beleza do reino do espírito, para seu próprio prazer pessoal e para proveito da comunidade." Albert Einstein

Código de segurança
Atualizar

PROMOÇÃO DIDÁTICOS SABEREXCEL



Adquira já o Acesso Imediato
à Area de Membros

Compra Grantida --- Entrega Imediata

Aprenda Excel VBA com Simplicidade de 
códigos e Eficácia, Escrevendo Menos e
Fazendo Mais.

'-------------------------------------'
Entrega Imediata:
+  500 Video Aulas MS Excel VBA
+  35.000 Planilhas Excel e VBA
+  Coleção 25.000 Macros MS Excel VBA
+  141 Planilhas Instruções Loops
+  341 Planilhas WorksheetFunctions(VBA)
+    04 Módulos Como Fazer Excel VBA
+  Curso Completo MS Excel VBA
+  Planilhas Inteligentes

Pesquisa Google SaberExcel

Google

Contatos Equipe Saberexcel

Navegar pelo Site

Outros Assuntos

Publicidade Google

<script type="text/javascript"><!--

google_ad_client = "ca-pub-2317234650173689";

/* retangulo 336 x 280 */

google_ad_slot = "0315083363";

google_ad_width = 336;

google_ad_height = 280;

//-->

</script>

<script type="text/javascript"

src="http://pagead2.googlesyndication.com/pagead/show_ads.js">

</script>

Publicidade

Tags Populares

RSFirewallProtected

22.12.2024

Google Associados

Depoimentos

Adicione Saberexcel Favoritos

 
 

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


   Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA