Saberexcel - o site das macros
Exemplo de procedimentos do Aplicativo Microsoft Excel VBA, contendo oito(8) exemplos de Listbox, muito bom para usarmos em nossos projetos e trabalhos do dia-a-dia. Espero que isso possam ajudá-los. Fiquem com Deus, E_Marcondes






Imagem do exemplo da listbox 1


Option Explicit

Private Sub cmbOK_Click()

If ListBox1.ListIndex = -1 Then
MsgBox "Nenhuma lista valor selecionado!", vbCritical
Exit Sub
End If

Cells(2, 1).Value = ListBox1.Value

Unload Me
End Sub

Private Sub cmFechar_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim vaManad As Variant

vaManad = Array("Janeiro", "Fevereiro", "Março", "Abril", _
"Maio", "Junho", "Julho", "Agosto", _
"Setembro", "Outubro", "Novembro", _
"Dezembro")

With ListBox1
.Clear
.List = vaManad
.ListIndex = -1
.TextAlign = fmTextAlignCenter
End With

End Sub

'...............................'

Abaixo Imagem e procedimentos do exemplo da Listbox2

Option Explicit

Private Sub cmbOK_Click()
If ListBox2.ListIndex = -1 Then
MsgBox "Nennhum valor da lista foi selecionado!", vbCritical, "Saberexcel - o site das macros"
Exit Sub
End If

Cells(2, 3).Value = ListBox2.Value

Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim vGrupos, iValores As Variant
Dim stLista() As String
Dim i As Integer

vGrupos = VBA.Array("AA", "BB", "CC")
iValores = VBA.Array("10", "20", "30")

ReDim stLista(0 To UBound(vGrupos), 0 To 1)

For i = 0 To UBound(vGrupos)
stLista(i, 0) = vGrupos(i)
stLista(i, 1) = iValores(i)
Next i

With ListBox2
.Clear
.BoundColumn = 2
.ColumnCount = 2
.List = stLista
.ListIndex = -1
End With
End Sub

Private Sub mdFechar_Click()
Unload Me
End Sub



'...............................'

Abaixo Imagem e procedimentos do exemplo da Listbox3

Option Explicit

Private Sub cmbOK_Click()
Dim i As Integer
Dim rnCell As Range

Set rnCell = Sheets("ListBox3").Range("A1")

If ListBox3.ListIndex = -1 Then
MsgBox "Nenhum valor da lista foi selecionado!", vbCritical, "Saberexcel - o site das macros"
Exit Sub
End If

For i = 0 To ListBox3.ListCount - 1
If ListBox3.Selected(i) Then _
rnCell.Offset(i, 0).Value = ListBox3.List(i)
Next i

Unload Me
End Sub

Private Sub cmdFechar_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim vLista, iValores As Variant
Dim stLista() As String
Dim i As Integer

vLista = VBA.Array("AA", "BB", "CC")
iValores = VBA.Array("10", "20", "30")

ReDim stLista(0 To UBound(vLista), 0 To 1)

For i = 0 To UBound(vLista)
stLista(i, 0) = vLista(i)
stLista(i, 1) = vaAndra(i)
Next i

With ListBox3
.Clear
.BoundColumn = 2
.ColumnCount = 2
.List = stLista
.ListIndex = -1
.MultiSelect = fmMultiSelectMulti
.TextAlign = fmTextAlignCenter
End With

End Sub





'...............................'
Abaixo Imagem e procedimentos do exemplo da Listbox4

Option Explicit

Private Sub cmbOK_Click()
Dim i As Integer
Dim rnCell As Range

Set rnCell = Sheets("ListBox4").Range("A1")

If ListBox2.ListIndex = -1 Then
MsgBox "Insira o valor na lista!", vbCritical
Exit Sub
End If

rnCell.Value = ListBox2.Value

Unload Me
End Sub

Private Sub ListBox1_Click()
Dim vaJan, vaFev, VaMar, vaAbril As Variant

vaJan = VBA.Array("1", "2", "3")
vaFev = VBA.Array("10", "20", "30")
VaMar = VBA.Array("100", "200", "300")
vaAbril = VBA.Array("1000", "2000", "3000")

Select Case ListBox1.Value
Case "Janueiro"
ListBox2.List = vaJan
Case "Fevereiro"
ListBox2.List = vaFev
Case "Março"
ListBox2.List = VaMar
Case "Abril"
ListBox2.List = vaAbril
End Select

End Sub

Private Sub UserForm_Initialize()
Dim vaLista1 As Variant

vaLista1 = VBA.Array("Janeiro", "Fevereiro", "Março", "Abril")

With ListBox1
.Clear
.List = vaLista1
End With
End Sub

Private Sub cmdFechar_Click()
Unload Me
End Sub

'...............................'
Abaixo Imagem e procedimentos do exemplo da Listbox5

Option Explicit

Private Sub cmbOK_Click()
Dim i, j As Integer
Dim rnCell As Range

Set rnCell = Sheets("ListBox5").Range("A1")

If ListBox5.ListIndex = -1 Then
MsgBox "Nenhum valor foi seleciona nesta lista!", vbCritical, "Saberexcel - o site das macros"
Exit Sub
End If

j = 0
For i = 0 To ListBox5.ListCount - 1
If ListBox5.Selected(i) Then
j = j + 1
rnCell.Offset(j, 0).Value = ListBox5.List(i, 0)
rnCell.Offset(j, 1).Value = ListBox5.List(i, 1)
End If
Next i

Unload Me
End Sub

Private Sub cmdFechar_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim iValores, vaAndra As Variant
Dim stLista() As String
Dim i As Integer

iValores = VBA.Array("AA", "BB", "CC")
vaAndra = VBA.Array("10", "20", "30")

ReDim stLista(0 To UBound(iValores), 0 To 1)

For i = 0 To UBound(iValores)
stLista(i, 0) = iValores(i)
stLista(i, 1) = vaAndra(i)
Next i

With ListBox5
.Clear
.BoundColumn = 2
.ColumnCount = 2
.List = stLista
.ListIndex = -1
.MultiSelect = fmMultiSelectMulti
End With

End Sub

Private Sub cmdFechar_Click()
Unload Me
End Sub

'...............................'
Abaixo Imagem e procedimentos do exemplo da Listbox6

Option Explicit

Private Sub UserForm_Initialize()
Dim vCelula, vIntervalo As Range

Set vIntervalo = Worksheets("Listbox6").Range("B2:G2")

For Each vCelula In vIntervalo
ListBox6.AddItem vCelula.Value
Next vCelula

End Sub

Private Sub cmbOK_Click()
Unload Me
End Sub



'...............................'
Abaixo Imagem e procedimentos do exemplo da Listbox7

Private Sub UserForm_Initialize()
Dim rnLista, rnCell As Range
Dim wkData As Worksheet

Set wkData = ThisWorkbook.Sheets("ListBox7")

Set rnLista = Union(wkData.Range("A2:A4"), wkData.Range("E2:E4"))

For Each rnCell In rnLista
ListBox7.AddItem rnCell.Value
Next rnCell

End Sub

Private Sub cmbOK_Click()
Unload Me
End Sub

'...............................'
Abaixo Imagem e procedimentos do exemplo da Listbox8

Option Explicit

Private Sub cmbOK_Click()
Dim iDados, vLista As Integer
Dim i, j As Integer
Dim vTemp As String

iDados = 0
vLista = ListBox8.ListCount - 1

For i = iDados To vLista - 1
For j = i + 1 To vLista
If ListBox8.List(i) > ListBox8.List(j) Then
vTemp = ListBox8.List(j)
ListBox8.List(j) = ListBox8.List(i)
ListBox8.List(i) = vTemp
End If
Next j
Next i

End Sub

Private Sub cmdFechar_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim vMeses As Variant
vMeses = Array("Jan", "Fev", "Mar", "Abr", _
"Mai", "Jun", "Jul", "Ago", _
"Set", "Out", "Nov", _
"Dez")

With ListBox8
.Clear
.List = vMeses
.ListIndex = -1
End With

End Sub

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA - com SaberExcel

Saberexcel - o Site das Macros

Estas macros do Aplicativo Microsoft Excel VBA, mostram horas através de um userform, horas continuas
Relógio digital, que funcionará como um Spash
Esses procedimentos junto com a declaração Global (Boolean), insere um relogio digital no rótulo(label)
de determinado Userform(Formulário)

1 objeto Userform1 ............: - Caption "Userform1"
1 objeto Label....................: - Caption "Label1"
1 objeto CommandButton....: - Caption "CommandButton"

'NO MÓDULO COMUM STANDARD INSIRA AS MACROS E VARIAVEL GLOBAL ABAIXO
Global onOff As Boolean

Sub MostrarFormulário()
UserForm1.Show
End Sub

Sub MostrarHoras()
On Error Resume Next
'colocação da data e horas devidamente formatadas
'veja que aqui inserimos as horas no Caption do Userform, Label e Frame1

UserForm1.Caption = "Hoje é dia: [ " & Format(Now, "dddd dd-mm-yyyy") & " ] Agora são: [ " & Format(Now, "hh:mm:ss") & " ] horas"
UserForm1.Label1.Caption = Format(Now, "dddd dd-mm-yyyy hh:mm:ss")
UserForm1.Frame1.Caption = "Hoje é dia: [ " & Format(Now, "dddd dd-mm-yyyy") & " ] Agora são: [ " & Format(Now, "hh:mm:ss") & " ] horas"

'só é executado se o formulário estiver activo
If onOff = True Then
Application.OnTime Now + TimeValue("00:00:01"), "MostrarHoras"
Else
Application.OnTime 0, ""
End If

End Sub

'Essa macro usando evento Open que abrirá o formulário na Abertura do Livro
Sub Auto_Open()
On Error Resume Next
UserForm1.Show
End Sub

'NA FOLHA DE CÓDIGO DO USERFORM
Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Activate()
onOff = True ' variável declarada como global as boolean
'inicia o ciclo de a cada segundo actualizar as horas no formulário
Application.OnTime Now + TimeValue("00:00:01"), "MostrarHoras"
End Sub

'Aqui o Evento Terminate encerra o ciclo de atualização por encerramento do formulário
Private Sub UserForm_Terminate()
onOff = False
End Sub

'Por exemplo se voce quiser abrir um userform chamado Spash
'faça uma macro que abre ativará um form splash e o fecha em 5 segundos.

'Private Sub UserForm_Activate()
'Application.OnTime Now + TimeValue("00:00:05"), "FechaSplash"
'End Sub


Aprenda Microsoft Excel VBA --((SaberExcel ))--

Estas macros do Aplicativo Microsoft Excel VBA, mostram horas através de um userform, horas continuas
Relógio digital, que funcionará como um Spash
Esses procedimentos junto com a declaração Global (Boolean), insere um relogio digital no rótulo(label)
de determinado Userform(Formulário)

1 objeto Userform1 ............: - Caption "Userform1"
1 objeto Label....................: - Caption "Label1"
1 objeto CommandButton....: - Caption "CommandButton"

'NO MÓDULO COMUM STANDARD INSIRA AS MACROS E VARIAVEL GLOBAL ABAIXO
Global onOff As Boolean

Sub MostrarFormulário()
UserForm1.Show
End Sub

Sub MostrarHoras()
On Error Resume Next
'colocação da data e horas devidamente formatadas
'veja que aqui inserimos as horas no Caption do Userform, Label e Frame1

UserForm1.Caption = "Hoje é dia: [ " & Format(Now, "dddd dd-mm-yyyy") & " ] Agora são: [ " & Format(Now, "hh:mm:ss") & " ] horas"
UserForm1.Label1.Caption = Format(Now, "dddd dd-mm-yyyy hh:mm:ss")
UserForm1.Frame1.Caption = "Hoje é dia: [ " & Format(Now, "dddd dd-mm-yyyy") & " ] Agora são: [ " & Format(Now, "hh:mm:ss") & " ] horas"

'só é executado se o formulário estiver activo
If onOff = True Then
Application.OnTime Now + TimeValue("00:00:01"), "MostrarHoras"
Else
Application.OnTime 0, ""
End If

End Sub

'Essa macro usando evento Open que abrirá o formulário na Abertura do Livro
Sub Auto_Open()
On Error Resume Next
UserForm1.Show
End Sub

'NA FOLHA DE CÓDIGO DO USERFORM
Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Activate()
onOff = True ' variável declarada como global as boolean
'inicia o ciclo de a cada segundo actualizar as horas no formulário
Application.OnTime Now + TimeValue("00:00:01"), "MostrarHoras"
End Sub

'Aqui o Evento Terminate encerra o ciclo de atualização por encerramento do formulário
Private Sub UserForm_Terminate()
onOff = False
End Sub

'Por exemplo se voce quiser abrir um userform chamado Spash
'faça uma macro que abre ativará um form splash e o fecha em 5 segundos.

'Private Sub UserForm_Activate()
'Application.OnTime Now + TimeValue("00:00:05"), "FechaSplash"
'End Sub


Aprenda Microsoft Excel VBA --((SaberExcel ))--

Objeto label do Aplicativo microsoft Excel VBA,
Saberexcel - o site das macros

Objeto Controle Label
Os controles de labels são principalmente usados para descrever outros controles em um UserForm. Um controle de labels não pode ser editado pelo usuário enquanto o UserForm está sendo executado. Use a propriedade de Legenda para estabelecer ou devolver o texto em um controle de labels. Outras propriedades freqüentemente usadas para formatar um controle de Label incluem a propriedade de Fonte e a propriedade ForeColor.
Como usar propriedades com a afirmação para formatar um controle de labels

Para usar O com a afirmação para modificar as propriedades de um controle de Etiqueta, siga esses passos: Inicie o excel e faça os passos seguintes
Na barra de ferramentas , aponte para a Macro, clique no Editor Básico Visual.
no botão de inserção de objetos do visual basic clique UserForm para inserir um UserForm no seu livro de exercícios.
Acrescente ao userform um label (rótulo)
Acrescente um controle de CommandButton ao UserForm.
Clique duas vezes o controle de CommandButton para abrir a janela de Código do UserForm.
Na janela de Código, digite(Copie e cole) o código seguinte do evento de Clique de CommandButton1:

Private Sub CommandButton1_Click()

With Label1
' atribuindo o texto ao objeto label
.Caption = "Este é o exemplo do Label 1"
' determinando o tamanho automatico do label (do tamanho do texto) .
.AutoSize = True
.WordWrap = False
' atribuindo o tamanho a fonte, o tamanho e estilo da fonte como também a cor.
.Font.Name = "Times New Roman"
.Font.Size = 14
.Font.Bold = True
' Atribuindo a cor da fonte (Azul)
.ForeColor = RGB(0, 0, 255)
End With

End Sub



Depois de inserido o procedimento execute o userform.
Click no botão CommandButton.
O texto "Isto é o Exemplo de Etiqueta 1"




Aprenda tudo sobre Aplicativo Microsoft Excel VBA - com SaberExcel

Saberexcel - Site das Macros
Essas declarações e procedimentos do Aplicativo Microsoft Excel VBA, impede o usuário de mover o userform (formulário) pela folha de planilha, tornando-o estático, imóvel.


Private Declare Function RemoveMenu _
Lib "user32" ( _
ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long) _
As Long

Private Declare Function FindWindowA _
Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Long) As Long

Private Const MF_BYPOSITION As Long = &H400

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim lFrmHdl As Long, iCount As Integer
lFrmHdl = FindWindowA(vbNullString, Me.Caption)
If lFrmHdl <> 0 Then
'MF_BYCOMMAND
'Indicates that uPosition gives the identifier of the menu item.

'If neither the MF_BYCOMMAND nor MF_BYPOSITION flag is specified,
'the MF_BYCOMMAND flag is the default flag.

'MF_BYPOSITION
'Indicates that uPosition gives the zero-based relative position of the menu item.
'ie 0,1,2,3 etc
'Exit Sub
'Typical Windows has 6 menus
'Restore, Move, Size, Minimise, Maximize, Close
'Even though a Userform displays 2 = Move & Close
'By default Move is the Next item
'so just loop twice
For iCount = 0 To 1
RemoveMenu GetSystemMenu(lFrmHdl, False), 0, MF_BYPOSITION
Next iCount

End If
End Sub


Aprenda tudo sobre o Aplicativo Microsoft Excel VBA - SaberExcel