Funções, rotinas e dicas

Varias Opções para FORMs muito uteis:

CLIQUE AQUI

Eis outro link com dicas:

http://www.silicio.com.br/vb/dicas/abertura.html

Pode ser que muitos saibam dessas discas de uso, mais vou cita-las, são bem uteis:1- Quando estiver digitando um comando, utilize (CTRL + ESPAÇO), o VB te mostra todos os comando que você pode estar utilizando nessa linha.2- Quando desejar procurar uma propriedade de um Objeto, ao invez ficar rolando a barra com o mouse, aperte: CHIFT + CTRL + (a primeira letra da propriedade.Exemplo, você quer a propriedade "TEXT" = CHIFT + CTRL + T3 - Ao ver uma chamada de Função, Sub ou Variavel, para ir até a definição dela basta clicar com 'botão direito' no nome > 'Definition'4 - Para movimentar objetos de um Form com teclado: Segure CTRL e mova com as setas do teclado5 - Para redimensionar objetos de um Form com teclado: Segure SHIFT e redimensione com as setas do teclado...é isso ae Galera.... Em breve posto mais, continuem postando, Até mais!

Dois tutoriais de sockets em VB:

http://www.desenvolvedores.net/modules.php...=article&sid=27

http://www.desenvolvedores.net/modules.php...=article&sid=26

Ah, vou pendurar esse tópico para ficar sempre visível. Boa idéia, Slype! :D

Abraços,

Graymalkin

Função pra validar um e-mail

Public Function EmailOK(ByVal Email As String) As Boolean Dim j As Long, C As String If Email = "" Or Email Like "@" And _ (Email Like ".??" Or Email Like ".???") _ Then EmailOK = True If Email Like "*.???" Then C = Right$(Email, 4) If C = ".com" Or C = ".net" Or C = ".edu" _ Or C = ".mil" Or C = ".gov" Or C = ".org" Then Else EmailOK = False End IfEnd IfFor j = 1 To Len(Email) C = Mid$(Email, j, 1) If C = "@" Or C = "." Or C = "-" Or C = "_" _ Or C >= Chr(48) And C <= Chr(57) _ Or LCase(C) >= Chr(97) And _ LCase(C) <= Chr(122) ThenElse EmailOK = FalseEnd IfNext jEnd Function

Pra chamar a função:

If EMailOK(seuemail.text)= true then Msgbox "E-mail válido"Else Msgbox "E-mail inválido"End If

10 dicas básicas sobre impressão com Printer.

http://www.macoratti.net/vb_print2.htm

Use Expressoes Regulares no VB

http://www.macoratti.net/vb_regex.htm

http://guia-er.sourceforge.net/

use ER muito melhor para validar dados tipo email, datas hora etc...

Uma SUBzinha bastante Util que eu mesmo Criei...

Função: Escrever direto em uma MSFlexGrid

Vamos Lá....

Cole em um Módulo:

Public Sub EscreveNaGrid(Grid As MSFlexGrid, Coluna As Integer, Linha As Integer, Key As Integer, SóNumero As Boolean)'Sub Criada por Slype - 20/02/2006 On Error Resume Next If Key = 8 Then Grid.TextMatrix(Linha, Coluna) = Left(Grid.TextMatrix(Linha, Coluna), Len(Grid.TextMatrix(Linha, Coluna)) - 1) ElseIf Key = 13 Then Grid.Row = Grid.Row + 1 Else If SóNumero = True Then If Not IsNumeric(Chr(Key)) And Key <> 44 Then Exit Sub End If Grid.TextMatrix(Linha, Coluna) = Grid.TextMatrix(Linha, Coluna) & Chr(Key) End IfEnd Sub

Chame a função no Evento KeyPress do seu MSFlexGrid:

Private Sub NomeDoGrid_KeyPress(KeyAscii As Integer) EscreveNaGrid NomeDoGrid, NomeDoGrid.Col, NomeDoGrid.Row, KeyAscii, FalseEnd Sub

... Caso queira que seje digitado Somente Numeros Então chame assim:

Private Sub NomeDoGrid_KeyPress(KeyAscii As Integer) EscreveNaGrid NomeDoGrid, NomeDoGrid.Col, NomeDoGrid.Row, KeyAscii, TrueEnd Sub

É isso ai... Espero que Seje Util á Voces!!!

falowww ate mais!!!

Trocar Tab por Enter

se precisar usar em varios campos coloque no keypress do formulario

e deixe o KeyPreview do formulário para True

If KeyAscii = 13 Then SendKeys "{tab}"

para evitar um beep deixe o keyascii com valor 0 :

If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If

Permitir só numeros no campo text

coloque no KeyPress do campo text

KeyAscii = IIf(KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8, KeyAscii, 0)

Exibir a data atual no padrao dd/mm/yyyy

só usar o format()

Format(Date, "dd/mm/yyyy")

Ultimo dia do mes:

Format(DateSerial(Year(Now), Month(Now) + 1, 0), "dd/mm/yyyy")

Deixar o campo text somente com letras maiusculas:

KeyAscii = Asc(UCase(Chr(KeyAscii)))

obs: para forçar somente minusculas use a função LCase no lugar da UCase

Função que preenche com zeros a esquerda ou direita do numero

coloque num modulo a função abaixo:

Public Function FormataZero_Esquerda(Valor As String, Casas As String)
FormataZero_Esquerda = Left(Casas, Len(Casas) - Len(Valor)) & Valor
End Function

modo de usar :

msgbox FormataZero_Esquerda("12", "00000")

obs: para preencher com zeros a direita só inverter "Valor" na função colocando ele na frente

e pode preencher com outro caracter sem ser zero

Conexao Com banco de Dados MySQL usando Dll nativa "libmySQL", sem usar ODBC ou Drivers

basta Referenciar a MyVbQL.dll

e usar assim:

Dim my As MYSQL_CONNECTION
Set my = New MYSQL_CONNECTION

my.OpenConnection "localhost", "usuario", "senha", "banco"

If my.State = MY_CONN_OPEN Then
MsgBox "successo"
Else
MsgBox "Falha na conexao"
End If

Set MyRS = my.Execute("select * from tabela")

alguns metodos:

MsgBox MyRS.RecordCount
MsgBox MyRS.FieldCount
MsgBox MyRS.Fields(0).Name

procurem essa dll no google é facil de achar mas quem nao conseguir posta ai que eu envio a dll por email

e ela tem muitos outros recursos apenas mostrei como conectar

existe tbm MyOLEDB.exe para conectar usando Provider mas nao gostei muito prefiro a MyVbQL

qualquer duvida só postar

Calcular idade:

Int(DateDiff("y", CDate(data_niver), Date) / 365.25)

• Função para Encher um ComboBox com Dados de um Campo de uma Tabela (em ADO)

Função:

Public Function DadosCBOtabela(Cb As ComboBox, Tabela As String, Campo As String) As Boolean Dim Seleção as ADODB.Recordset StrTemp = Cb.Text Cb.Clear Set Seleção = New ADODB.Recordset Seleção.Open "SELECT " & Campo & " FROM " & Tabela & " ORDER BY " & Campo, BDdados, adOpenDynamic, adLockReadOnly If Seleção.EOF = True Then DadosCBOtabela = False Seleção.Close Exit Function End If Do While Not Seleção.EOF Cb.AddItem IIf(IsNull(Seleção(Campo)), "", Seleção(Campo)) Seleção.MoveNext Loop DadosCBOtabela = True Seleção.Close Cb.Text = StrTemp StrTemp = ""End Function*Onde BDdados é uma connexão ADO com um Banco....

• Ex de uma connexão ADO com BD Access:

Dim BDdados as ADODB.Connection Set BDdados = New ADODB.Connection BDdados.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=SENHA;" & "Data Source=C:\Dados.mdb;" & "Persist Security Info=False" BDdados.Open• Como chamar a Função:

DadosCBOtabela Cbo_Nome, "Clientes", "Nome"...é isso ae galera.....Taí mais uma funçãozinha show de bola!!! =]Até mais!!!

Função muito util na hora de criar uma pasta:

Caso voce queira criar a pasta "c:\func\vb\imasters" e não existe nenhuma dessas pastas, nem a func, ao inves de criar uma por uma usando o MKDIR, jogue esse caminho nessa funcao:

Public Function NewPath(path As String) As StringDim QuebraPasta As VariantDim CriaPasta As StringDim cont As IntegerDim QuebraParametro As VariantOn Error GoTo trataIf Right(path, 1) = "\" Then path = Left(path, Len(path) - 1)If FileExist(path) = False Then QuebraPasta = Split(path, "\") For cont = 1 To UBound(QuebraPasta) If cont = UBound(QuebraPasta) Then QuebraParametro = Split(QuebraPasta(cont), ";") If cont = 1 Then CriaPasta = QuebraPasta(0) & "\" & QuebraParametro(0) Else CriaPasta = CriaPasta & "\" & QuebraParametro(0) End If Else If CriaPasta = "" Then CriaPasta = QuebraPasta(cont - 1) & "\" & QuebraPasta(cont) Else CriaPasta = CriaPasta & "\" & QuebraPasta(cont) End If End If If Not FileExist(CriaPasta) Then MkDir (CriaPasta) Next contEnd Iftrata:If Err.Number = 76 Or Err.Number = 75 Then Resume NextElseIf Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description, vbCriticalEnd IfEnd Function

Tai mais uma de minhas Subs...

essa é show de bola, quebra um galhão nos meus sistemas...

• Serve para carregar um ComboBox com Informações (baseado no parametro (Tipo) que você passa)

• Vcs podem colocar mais coisas nela... é só seguir o eskema:

Public Sub DadosCBO(Cb As ComboBox, Tipo As String, Optional NumIni As Double, Optional NumFim As Double) Cb.Clear Tipo = LCase(Tipo) Select Case Tipo Case "meses" Cb.AddItem "Janeiro" Cb.AddItem "Fevereiro" Cb.AddItem "Março" Cb.AddItem "Abril" Cb.AddItem "Maio" Cb.AddItem "Junho" Cb.AddItem "Julho" Cb.AddItem "Agosto" Cb.AddItem "Setembro" Cb.AddItem "Outubro" Cb.AddItem "Novembro" Cb.AddItem "Dezembro" Case "diasemana" Cb.AddItem "Domingo" Cb.AddItem "Segunda" Cb.AddItem "Terça" Cb.AddItem "Quarta" Cb.AddItem "Quinta" Cb.AddItem "Sexta" Cb.AddItem "Sábado" Case "numeros" Do While NumIni <= NumFim Cb.AddItem NumIni NumIni = NumIni + 1 Loop Case "estados" Cb.AddItem "AC" Cb.AddItem "AL" Cb.AddItem "AM" Cb.AddItem "AP" Cb.AddItem "BA" Cb.AddItem "CE" Cb.AddItem "DF" Cb.AddItem "ES" Cb.AddItem "GO" Cb.AddItem "MA" Cb.AddItem "MG" Cb.AddItem "MS" Cb.AddItem "MT" Cb.AddItem "PA" Cb.AddItem "PB" Cb.AddItem "PE" Cb.AddItem "PI" Cb.AddItem "PR" Cb.AddItem "RJ" Cb.AddItem "RN" Cb.AddItem "RO" Cb.AddItem "RR" Cb.AddItem "RS" Cb.AddItem "SC" Cb.AddItem "SE" Cb.AddItem "SP" Cb.AddItem "TO" Case "impressoras" For Each ImprComputador In Printers Cb.AddItem ImprComputador.DeviceName Next ImprComputador Case "estadocivil" Cb.AddItem "Amasiado(a)" Cb.AddItem "Casado(a)" Cb.AddItem "Desquitado(a)" Cb.AddItem "Divorciado(a)" Cb.AddItem "Separado(a)" Cb.AddItem "Solteiro(a)" Cb.AddItem "Viúvo(a)" Cb.AddItem "2º União" Case "sexo" Cb.AddItem "Masculino" Cb.AddItem "Feminino" End SelectEnd Sub

... show de bola pessoal... continuem postando!!! Até mais!

Informar a data ex:Dim as dhoje as stringdhohe = RetDia(11/03/2007)Retorno = Domingo, 11 de Março de 2007Public Function RetDia(qData As Date) As String Dim Dia(), Mes(), lngValor As Integer Dia = Array("Domingo", "Segunda-Feira", "Terça-Feira", "Quarta-Feira", "Quinta-Feira", "Sexta-Feira", "Sábado") lngValor = Weekday(qData) Mes = Array("Janeiro", "Fevereiro", "Março", "Abril", "Maio", "Junho", _ "Julho", "Agosto", "Setembro", "Outubro", "Novembro", "Dezembro") RetDia = Dia(lngValor) + ", " + CStr(Day(qData)) + " de " + Mes(Month(qData)) + " de " + CStr(Year(qData))End Function

Algumas vezes precisamos realizar checks, comparações etc.Abaixo crieI uma função que me retorna se pode ou não digitar uma informação.No exemplo abaixo verifico se um lançamento de horas é valido ou não. ( Uso horas no formato texto 00:00 a 23:59 convertidos em minutos de 0 a 1439 )No form da digitação deixo um listbox invisivel, onde a função abaixo preenche com os parâmetros enviados.List1 = listboxtE1 = por exemplo : 720 , ou seja 12:00 60 minutos.tS2 = por exemplo : 1080 , ou seja 18:00 60 minutos.val(TxtAte.text) = o valor digitado.Será carregado no listbox os valores entre 720 a 1080'------------------------------------------------------------------------------------------------------------If ChekHorasDigitadas(List1, tE1, tS2, val(TxtAte.text)) = "S" Then msgbox "Localizado" 'Ok permitidoendif'------------------------------------------------------------------------------------------------------------Public Function ChekHorasDigitadas(ListaResu As ListBox, HTabini, HTabfim, HDigit) Dim a As Integer, f As Integer, I As Integer Dim xHoraLocalizada As Integer Dim Hinicial As Integer Dim Hfinal As Integer Hinicial = HTabini Hfinal = HTabfim If Hfinal < Hinicial Then Hfinal = Hfinal + 1440 End If ListaResu.Clear For a = Hinicial To Hfinal If a < 1440 Then ListaResu.AddItem a End If If a = 1440 Then Hinicial = 0 Hfinal = Hfinal - 1440 For f = Hinicial To Hfinal ListaResu.AddItem f Next End If Next For I = 0 To ListaResu.ListCount - 1 xHoraLocalizada = ListaResu.List(I) If xHoraLocalizada = HDigit Then ChekHorasDigitadas = "S" Exit Function Else ChekHorasDigitadas = "N" End If Next End Function'------------------------------------------------------------------------------------------------------------Utilizando a mesma lógica você pode usar a função com poucas modificação para fazer outras verificações, por exemplo :Verificação de UF, Cidades, Numeros sequenciais ou não, e outros conforme sua imaginação.Poderia tambem ser realizado ao invés de usar o ListBox, poderia ser usado uma Matrix(x), mas preferi dessa forma, visto que confiro todos os resultados no ato no listbox)tenha o cuidado de não permitir o estouro do listbox ou a performance, caso o conteudo temporários do listbox seja muito extensa.

fazer um form ficar na frente de todos, sem permitir que acesse outro form no aplicativo, tipo um msgbox!

exemplo:

'NO ENVENTO EM QUE você VAI CHAMAR O FORMPrivate sub Command1_Click()form1.show 1end sub

Aê galera, beleza?

Não sei se será útil para alguém, mas eu precisei dessa coisa e num achei em lugar nenhum. Então, depois de feito, é hora de compartilhar...

Justificar parágrafo em VB com objeto PRINTER

Você vai precisar de um arquivo de módulo. No meu caso, chamei-o de modPrinter.bas

Public Const PHYSICALHEIGHT = 111
Public Const PHYSICALWIDTH = 110
Public Const PHYSICALOFFSETX = 112
Public Const PHYSICALOFFSETY = 113

Public Type SIZE
cx As Long
cy As Long
End Type

Public Declare Function _
GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" ( _
ByVal hdc As Long, _
ByVal lpsz As String, _
ByVal cbString As Long, _
lpSize As SIZE _
) As Long

Public Declare Function _
SetTextJustification Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal nBreakExtra As Long, _
ByVal nBreakCount As Long _
) As Long

Public Declare Function _
TextOut Lib "gdi32" Alias "TextOutA" ( _
ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal lpString As String, _
ByVal nCount As Long _
) As Long

Public Declare Function _
GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal nIndex As Long _
) As Long

E aqui vai o arquivo de classe, que chamei de CPrinter.cls

Option Explicit

Private m_hDC As Double
Private m_LeftMargin As Long
Private m_RightMargin As Long
Private m_LineSize As Long
Private m_LineHeight As Long

Private Function getLineSpaces(ByVal szText As String) As Long
getLineSpaces = UBound(Split(szText, " "))
End Function

Public Property Let hdc(ByVal lngParm As Double)
m_hDC = lngParm
End Property
Public Property Get hdc() As Double
hdc = m_hDC
End Property

'Selectiona a impressora desejada pelo nome. Retorna o nome da impressora anteriormente selecionada
Public Function setPrinterDevice(ByVal szDeviceName) As String
Dim sz As SIZE
Dim lPtr As Printer
setPrinterDevice = Printer.DeviceName
Printer.KillDoc
If (szDeviceName <> "") Then
For Each lPtr In Printers
If (lPtr.DeviceName = szDeviceName) Then
Set Printer = lPtr
Exit For
End If
Next
End If
m_hDC = Printer.hdc
m_LeftMargin = GetDeviceCaps(m_hDC, PHYSICALOFFSETX)
m_RightMargin = GetDeviceCaps(m_hDC, PHYSICALWIDTH) - (GetDeviceCaps(m_hDC, PHYSICALOFFSETX) * 2)
m_LineSize = m_RightMargin - m_LeftMargin

GetTextExtentPoint32 m_hDC, "X", 1, sz
m_LineHeight = sz.cy

Printer.Print
End Function

Public Function PrintText(ByVal szText As String)
Dim sz As SIZE
Dim iPos As Long
Dim iOldPos As Long
Dim szBuffer As String

Do While (szText <> "")
iPos = 0
szBuffer$ = ""
sz.cx = 0: sz.cy = 0
Do While (sz.cx <= m_LineSize And iPos < Len(szText) And iPos <> -1)
iOldPos = iPos
iPos = InStr(iPos + 1, szText, " ")
If (iPos = 0) Then
szBuffer$ = szText$
iPos = -1
Else
szBuffer$ = Left(szText$, iPos - 1)
End If
GetTextExtentPoint32 m_hDC, szBuffer$, Len(szBuffer$), sz
Loop
If (iPos = -1) Then
szBuffer$ = szText$
szText$ = ""
Else
szBuffer$ = Left$(szText$, iOldPos - 1)
szText$ = Mid$(szText$, iOldPos + 1)
End If

If (iPos <> -1) Then
GetTextExtentPoint32 m_hDC, szBuffer$, Len(szBuffer$), sz
SetTextJustification m_hDC, m_LineSize - sz.cx, getLineSpaces(szBuffer$)
Else
SetTextJustification m_hDC, 0, 0
End If
TextOut m_hDC, 0, Printer.CurrentY, szBuffer$, Len(szBuffer$)
SetTextJustification m_hDC, 0, 0
Printer.CurrentY = Printer.CurrentY + sz.cy
Loop
End Function

Public Sub newLine(Optional ByVal intLines As Integer = 1)
Printer.CurrentX = 0
Printer.CurrentY = Printer.CurrentY + (m_LineHeight * intLines)
End Sub

Public Sub EndDoc()
Printer.EndDoc
End Sub

E agora, um exemplo de utilização. Crie um form e coloque um botão no mesmo. No evento de click do botão, coloque algo como isto:

Private Sub Command2_Click()
Dim oPtr As New CPrinter
Dim szBuffer As String

'Seleciona a impressora desejada
oPtr.setPrinterDevice "" 'Sem informar nada, assume a impressora padrão configurada

szBuffer = "Coloque qualquer texto aqui. A função PrintText quebra as linhas e justifica para você"
oPtr.PrintText szBuffer$

'A função newLine salta um determinado número de linhas. Quando não for informado o número, assume o padrão de saltar 1 linha.
'IMPORTANTE: A função PrintText já salta para a próxima linha. Utilize newLine apenas para saltar mais linhas

oPtr.newLine 'Salta 1 linha
oPtr.newLine 1 'Salta 1 linha
oPtr.newLine 5 'Salta 5 linhas

szBuffer$ = "Coloque qualquer outro texto aqui"
oPtr.PrintText szBuffer$

Printer.EndDoc 'Finaliza impressão e despeja para a impressora
End Sub

É isso aê... espero ter ajudado alguém. Funcionou direitinho em uma HP DeskJet, em uma HP Laserjet e jogando para PDF via Easy PDF Creator.

Abs,

Roney

Criando uma aplicação em 3 camadas.

http://www.macoratti.net/vb_3cam.htm

http://www.macoratti.net/vb_3cam2.htm

http://www.macoratti.net/vb_3cam3.htm

Função Salvar "igual" do Notepad, Word, etc...

Crie uma váriavel(FormAlterado)para todo o form.

No load do form você coloca FormAlterado = False.

Nos eventos CHANGE dos seus textbox, combobox, e mais o que você tiver na tela, você coloca FormAlterado = True

Daí no evento QueryUnload do Form você verificaessa variavel.

Ficará assim:

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Dim mensagem As String, botões As Integer, titulo As String
Dim resposta As Integer
mensagem = "Deseja salvar as alterações ?" ' Define mensagem
botões = vbYesNoCancel + vbExclamation ' Define botões
titulo = "Cadastro de Clientes" ' Define título
resposta = MsgBox(mensagem, botões, titulo)
If resposta = vbNo Then 'se a resposta foi "não"
Unload Me
ElseIf resposta = vbYes Then 'se a resposta foi "sim"
cmdSalvar_Click
Else
Cancel = 1 'se a resposta foi "cancelar"
End If

End Sub
Pra mim foi útil pode ser pra vocês tmb...

Abraço!

Ordenando DataGrid no Visual Basic 6.

Como faremos isso?

Primeiro, usaremos o evento HEADCLICK do DataGrid.

Segundo, usaremos a propriedade sort do recordset para sortear a coluna em questão selecionada pelo usuário.

Veja exemplo:

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
adodc1.recordset.sort=adodc1.recordset.fields(colindex).name
End Sub
Grato,

Giancarlo Braga

Função para Marcar/desmarcar todos os filhos em uma treeview.

TV = minha treeview

Configure a treeview para usar checkbox

No evento NodeCheck:

Private Sub TV_NodeCheck(ByVal Node As MSComctlLib.Node)
If Node.Children > 0 Then
SelecionarFilhos Node.Key, Node.Checked
End If
end sub

Função:

Private Sub SelecionarFilhos(nKey As String, Check As Boolean)
For I = 1 To TV.Nodes.Count
Set Nx = TV.Nodes.Item(I)
If Nx.Tag <> "PAI" Then 'quando criei a treeview identifiquei com a Tag = Pai o primeiro nível'
If Nx.Parent.Key = nKey Then
Nx.Checked = Check
End If
End If
Next I
For I = 1 To TV.Nodes.Count
Set Nx = TV.Nodes.Item(I)
If Nx.Tag <> "PAI" Then
If Nx.Children > 0 And Nx.Checked = Check And Nx.Parent.Key = nKey Then
Nx.Expanded = True
SelecionarFilhos Nx.Key, Check
End If
End If
Next I
End Sub

>
Tai mais uma de minhas Subs...

essa é show de bola, quebra um galhão nos meus sistemas...

• Serve para carregar um ComboBox com Informações (baseado no parametro (Tipo) que você passa)

• Vcs podem colocar mais coisas nela... é só seguir o eskema:

Public Sub DadosCBO(Cb As ComboBox, Tipo As String, Optional NumIni As Double, Optional NumFim As Double)
Cb.Clear
Tipo = LCase(Tipo)

Select Case Tipo
	Case "meses"
 Cb.AddItem "Janeiro"
 Cb.AddItem "Fevereiro"
 Cb.AddItem "Março"
 Cb.AddItem "Abril"
 Cb.AddItem "Maio"
 Cb.AddItem "Junho"
 Cb.AddItem "Julho"
 Cb.AddItem "Agosto"
 Cb.AddItem "Setembro"
 Cb.AddItem "Outubro"
 Cb.AddItem "Novembro"
 Cb.AddItem "Dezembro"
	Case "diasemana"
 Cb.AddItem "Domingo"
 Cb.AddItem "Segunda"
 Cb.AddItem "Terça"
 Cb.AddItem "Quarta"
 Cb.AddItem "Quinta"
 Cb.AddItem "Sexta"
 Cb.AddItem "Sábado"
	Case "numeros"
 Do While NumIni <= NumFim
 Cb.AddItem NumIni
 NumIni = NumIni + 1
 Loop
	Case "estados"
 Cb.AddItem "AC"
 Cb.AddItem "AL"
 Cb.AddItem "AM"
 Cb.AddItem "AP"
 Cb.AddItem "BA"
 Cb.AddItem "CE"
 Cb.AddItem "DF"
 Cb.AddItem "ES"
 Cb.AddItem "GO"
 Cb.AddItem "MA"
 Cb.AddItem "MG"
 Cb.AddItem "MS"
 Cb.AddItem "MT"
 Cb.AddItem "PA"
 Cb.AddItem "PB"
 Cb.AddItem "PE"
 Cb.AddItem "PI"
 Cb.AddItem "PR"
 Cb.AddItem "RJ"
 Cb.AddItem "RN"
 Cb.AddItem "RO"
 Cb.AddItem "RR"
 Cb.AddItem "RS"
 Cb.AddItem "SC"
 Cb.AddItem "SE"
 Cb.AddItem "SP"
 Cb.AddItem "TO"
	Case "impressoras"
 For Each ImprComputador In Printers
 Cb.AddItem ImprComputador.DeviceName
 Next ImprComputador
	Case "estadocivil"
 Cb.AddItem "Amasiado(a)"
 Cb.AddItem "Casado(a)"
 Cb.AddItem "Desquitado(a)"
 Cb.AddItem "Divorciado(a)"
 Cb.AddItem "Separado(a)"
 Cb.AddItem "Solteiro(a)"
 Cb.AddItem "Viúvo(a)"
 Cb.AddItem "2º União"
	Case "sexo"
 Cb.AddItem "Masculino"
 Cb.AddItem "Feminino"
End Select

... show de bola pessoal... continuem postando!!! Até mais!

Caro amigo: Amasiado, desquitado e 2ª união não são "estado civil" brasileiro pelo código civil em vigência.