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 ))--

Saberexcel - o site de quem precisa aprender macros ms Excel VBA


Esses procedimentos do Aplicativo Microsoft Excel VBA(Visual Basic Application), com declarações retiram o cabeçalho do formulário.


Private Sub UserForm_Initialize()
Label2.Visible = False
RETIRAR_CABECALHO_SABEREXCEL Me.Caption, False
End Sub

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Const GWL_STYLE = (-16)
Const WS_CAPTION = &HC00000
Const SWP_FRAMECHANGED = &H20

Public Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long

Public Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, _
ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long

Sub RETIRAR_CABECALHO_SABEREXCEL(stCaption As String, sbxVisible As Boolean)
Dim vrWin As RECT
Dim style As Long
Dim lHwnd As Long
lHwnd = FindWindowA(vbNullString, stCaption)
GetWindowRect lHwnd, vrWin
style = GetWindowLong(lHwnd, GWL_STYLE)
If sbxVisible Then
SetWindowLong lHwnd, GWL_STYLE, style Or WS_CAPTION
Else
SetWindowLong lHwnd, GWL_STYLE, style And Not WS_CAPTION
End If
SetWindowPos lHwnd, 0, vrWin.Left, vrWin.Top, vrWin.Right - vrWin.Left, _
vrWin.Bottom - vrWin.Top, SWP_FRAMECHANGED
End Sub

Sub abrir_form()
frmSaber.Show
End Sub



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.

Saberexcel - o site das macros
Exemplo de planilha do Aplicativo Microsoft Excel VBA usando spinbutton relacionado a duas tabelas buscando dados.




Aprenda microsoft Excel VBA com SaberExcel

Saberexcel - o site das macros
Essas macros e procedimentos do Aplicativo Microsoft Excel VBA, abre um determinado objeto Userform(Formulário) em diversos posições na folha de planilhas, com auxílio de objetos Options, voce poderá escolher o lugar para o posicionamento do Userform.

EM UM MÓDULO COMUM INSIRA OS CÓDIGOS
Sub Abrir_userform()
If Sheets(1).ComboBox1.Text = "" Then
MsgBox "Selecione uma das opções"
Else

Select Case Sheets(1).ComboBox1.Text
Case "Centro"
UserForm1.StartUpPosition = 2
Case "Qualquer Lugar"
UserForm1.StartUpPosition = 1
End Select

UserForm1.Show
End If
End Sub

NA FOLHA [MÓDULO] DE CÓDIGO DO OBJETO USERFORM INSIRA OS PROCEDIMENTOS

Dim X As Integer, Y As Integer

Private Sub optCentro_Click()
If optCentro.Value Then
UserForm1.Left = X
UserForm1.Top = Y
End If
End Sub

Private Sub optDirAba_Click()
If optDirAba.Value Then
UserForm1.Left = ActiveWindow.Width - UserForm1.Width
UserForm1.Top = ActiveWindow.Height - UserForm1.Height
End If
End Sub

Private Sub optDirAci_Click()

If optDirAci.Value Then
UserForm1.Left = ActiveWindow.Width - UserForm1.Width
UserForm1.Top = 0
End If

End Sub

Private Sub optEsqAba_Click()
If optEsqAba.Value Then
UserForm1.Left = 0
UserForm1.Top = ActiveWindow.Height - UserForm1.Height
End If
End Sub

Private Sub optEsqAci_Click()
If optEsqAci.Value Then
UserForm1.Left = 0
UserForm1.Top = 0
End If
End Sub

Private Sub UserForm_Activate()
X = UserForm1.Left
Y = UserForm1.Top
End Sub

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA - SaberExcel

Procedimentos do Aplicativo MS Excel VBA, usando objetos textbox, no final da digitação dia, mes e ano, formata automaticamente o texto em uma outra textbox e também retorna o valor data para folha de planilha, no formato data(dd/mmm/aaaa).
1 - Userform
4 - Textbox
1 - CommandButton


Dim Dia As Integer
Dim Mês As Integer
Dim Ano As Integer

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub TextBox1_Change()
On Error Resume Next
If Len(TextBox1) = 2 Then
Dia = TextBox1
TextBox2.SetFocus
End If
End Sub

Private Sub TextBox2_Change()
On Error Resume Next
If Len(TextBox2) = 2 Then
Mês = TextBox2
TextBox3.SetFocus
End If
End Sub

Private Sub TextBox3_Change()
On Error Resume Next
If Len(TextBox3) = 4 Then
Ano = TextBox3
Call Validando_data
End If
End Sub

Private Sub Validando_data()
If Dia < 1 Or Dia > 31 Then
MsgBox "Dia Inválido"
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox1.SetFocus
Exit Sub
End If

If Mês < 1 Or Mês > 12 Then
MsgBox "Mês Inválido"
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox2.SetFocus
Exit Sub
End If

If Ano < 1990 Or Ano > 2011 Then
MsgBox "Mês Inválido"
TextBox3 = ""
TextBox4 = ""
TextBox3.SetFocus
Exit Sub
End If

TextBox4 = Format(Dia, "00") & "/" & Format(Mês, "00") _
& "/" & Format(Ano, "0000")
Sheets(1).Range("b5") = TextBox4

If IsError(Sheets(1).Range("B8")) Then
MsgBox "Data Inválida"
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""

Sheets(1).Range("B5").Value = Format(Now, "DD/MM/YYYY")
TextBox1.SetFocus
End If
'Frame1.Caption = "Data: " & TextBox1.Value & "/" & TextBox2.Value & "/" & TextBox3.Value 'ou
Frame1.Caption = "Data Digitada: " & Format(Dia, "00") & "/" & Format(Mês, "00") _
& "/" & Format(Ano, "0000")
End Sub


Aprenda tudo sobre o Aplicativo MS Excel VBA com SaberExcel

Publicidade:
Compre com Segurança, garantia e ótimos preços nas lojas submarino