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

Esse macro do aplicativo Microsoft Excel VBA, trabalham com Checkbox, formatando células, cor da fonte e interior, ao serem selecionados,
mudam os dados nas linhas especificas onde estão ancoradas, marcam a data e hora na coluna(b) e mensagem na coluna(C), ao serem habilitados.
Espero que o exemplo possam ajudá-los. Fiquem todos com Deus, Expedito Marcondes

Sub trabalhando_com_checkboxes()

Dim ckBOX As CheckBox
Dim vLinha As Integer
Dim LRange As String
Dim LBatataDoce As String 'Cristina uma variável pode conter qualquer nome desde que nao faça parte do scopo do vb, simbolos proibidos, e sem espaços.

vNome = Application.Caller
Set ckBOX = ActiveSheet.CheckBoxes(vNome)

'procura a linha onde esta a checkbox residencia dela
vLinha = ckBOX.TopLeftCell.Row
LRange = "B" & CStr(vLinha)
LBatataDoce = "C" & CStr(vLinha)

'insere a data na coluna(B) se a checkbox for habilitada
If ckBOX.Value > 0 Then
ActiveSheet.Range(LRange).Value = Now() 'Date
ActiveSheet.Range(LBatataDoce).Value = "Revisado,Entregue"
ActiveSheet.Range(LBatataDoce).Interior.ColorIndex = 35
ActiveSheet.Range(LBatataDoce).Font.ColorIndex = 1
ActiveSheet.Range(LBatataDoce).Font.Bold = False
ActiveSheet.Range(LRange).Interior.ColorIndex = 28

'limpar a data na coluna(B) se a checkbox for desabilitada

Else
ActiveSheet.Range(LRange).Value = Null
ActiveSheet.Range(LRange).Interior.ColorIndex = Null

ActiveSheet.Range(LBatataDoce).Value = "Aguardando Aprovação"
ActiveSheet.Range(LBatataDoce).Interior.ColorIndex = 3 'xlNone 'ou Null
ActiveSheet.Range(LBatataDoce).Font.ColorIndex = 2
ActiveSheet.Range(LBatataDoce).Font.Bold = True

End If

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

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

Esses procedimentos do aplicativo Microsoft Excel VBA(Visual Basic Application) carregam um objeto ListBox e um Objeto Combobox na inicialização de Userform(formulário).
Não deixe de ver nosso trabalho com Deslocamentos de dados (Células e Range) - assinantes.
'- - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub ComboBox1_Click()
Plan1.Range("L65000").End(xlUp).Offset(1, 0).Value = ComboBox1.Value
Frame2.Caption = "Item Inserido: [ " & ComboBox1.Value & " ]"
End Sub

Private Sub CommandButton1_Click()
[b].ClearContents 'celulas nomeadas como [b] ' nao deixe de ver nosso trabalho 'RENOMEANDO CÉLULAS'
MsgBox ("area deletada com sucesso!"), vbInformation, "Escola Saberexcel VBA Estudos"
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub ListBox1_Click()
Plan1.Range("n65000").End(xlUp).Offset(1, 0).Value = ListBox1.Value
Frame1.Caption = "Item Inserido: [ " & ListBox1.Value & " ]"
End Sub

'procedimento para posicionar o userform na folha de planilha
Private Sub UserForm_Activate()
With UserForm1
.Top = Application.Top + 322 '
.Left = Application.Left + 200
End With
End Sub

'veja que usei a propriedade Rowsource para carregar ambos objetos : combobox e listbox
Private Sub UserForm_Initialize()
Dim vLinha As String
vLinha = Range("a1").End(xlDown).Address
UserForm1.ListBox1.RowSource = "Usf_carrega_combobox_listbox!a1:" & vLinha & ""
UserForm1.ComboBox1.RowSource = "Usf_carrega_combobox_listbox!a1:" & vLinha & ""
ListBox1.ListIndex = 5
ComboBox1.ListIndex = 1
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 de quem precisa aprender Macros MS Excel VBA

Esses procedimentos do aplicativo Microsoft Excel VBA(Visual Basic Application), usando objetos textboxes, retorna a quantidade de textboxes
preenchidos, com uma operação matematica.

Private Sub cmdCONTAR_Click()
Dim vContador, iValor
ObjetosTxt = 10
iValor = 0

For vContador = 1 To ObjetosTxt
If Len(Me.Controls("cmbTEXTO" & vContador)) > 0 Then
iValor = iValor + 1
End If
Next

'uma mensagem com quebra de linhas -- intuito didático.
MsgBox "Neste formulário há: " & vbCrLf & _
"- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -" & vbCrLf & _
"[ " & iValor & _
" ] .....: - TextBox's preenchidos " & vbCrLf & "[ " & ObjetosTxt - iValor & _
" ] .....: - TextBox's Vazios " & vbCrLf & _
"[ " & Val(ObjetosTxt) & " ] .....: - TextBox's no Total" & _
vbCrLf & "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -" & _
vbCrLf & "Escola Saberexcel VBA Estudos® - Treinamentos" & _
vbCrLf & "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -", _
vbInformation, "Saberexcel VBA Estudos®"

End Sub

Private Sub cmdFECHAR_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Me.cmbTEXTO1.SetFocus
End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim Resposta As String
Resposta = MsgBox("deseja conectar com nosso site ?", vbYesNo + vbQuestion, "Saberexcel - site das macros")
If Resposta = vbYes Then
ThisWorkbook.FollowHyperlink "http://www.microsoftexcel.com.br/", , True
End If
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.

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

Esses procedimentos do Aplicativo Microsoft Excel VBA(visual Basic Application), com auxilio de um objeto ListView busca dados baseados
em determinados critérios e retorna também a soma dos valores Filtrados no objeto ListView, contém folha de planilha para o relatório de
dados filtrados.


Option Explicit
Dim TabelaTemp As Variant
Dim vUltimaLinha As Integer
Dim L As Integer
Dim X As Integer
Dim I As Integer
Dim C As Byte
Dim vLin As Integer
Dim TotalCol As Single

Private Sub CheckBox1_Click()
If frmLANCAMENTOS.CheckBox1.Value = True Then Call AdicionaItem
End Sub

Private Sub cbxAGENCIA_Change()
If frmLANCAMENTOS.CheckBox1.Value = True Then
Call AdicionaItem
Exit Sub
End If
If frmLANCAMENTOS.cbxAGENCIA.Value = "" Then Exit Sub
' verifica a combobox lista meses
frmLANCAMENTOS.cbxMESES.Value = ""
' & Se desmarcada, construído de acordo com a agência lista
With Me.ListView1
.ListItems.Clear
With .ColumnHeaders
.Clear
.Add , , "Data", 50
.Add , , "Agencia", 70
.Add , , "Cliente", 95
.Add , , "Total", 50
End With
.FullRowSelect = True
.Gridlines = True
.LabelEdit = 1
.ListItems.Clear
.View = lvwReport
With ThisWorkbook.Worksheets("BD")
.Activate
vUltimaLinha = .Range("A65535").End(xlUp).Row
TabelaTemp = .Range(.Cells(2, 1), .Cells(vUltimaLinha, 4)).Value
.Range("A1").Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
X = 1
TotalCol = 0
For L = 1 To UBound(TabelaTemp, 1)
If TabelaTemp(L, 2) = Me.cbxAGENCIA.Value Then
.ListItems.Add , , TabelaTemp(L, 1)
.ListItems(X).ListSubItems.Add , , TabelaTemp(L, 2)
.ListItems(X).ListSubItems.Add , , TabelaTemp(L, 3)
.ListItems(X).ListSubItems.Add , , TabelaTemp(L, 4)
TotalCol = TotalCol + TabelaTemp(L, 4)
X = X + 1
End If
Next
End With
'TOTAL
Me.TotListView.Value = TotalCol
With Me.txtTotal
Me.txtTotal = ListView1.ListItems.Count - 0
End With
End Sub

Private Sub cbxMESES_Change()
If frmLANCAMENTOS.CheckBox1.Value = True Then
Call AdicionaItem
Exit Sub
End If
If frmLANCAMENTOS.cbxMESES.Value = "" Then Exit Sub
frmLANCAMENTOS.cbxAGENCIA.Value = ""
' Se desmarcada, construído a lista por MÊS
With Me.ListView1
.ListItems.Clear
With .ColumnHeaders
.Clear
.Add , , "Data", 50
.Add , , "Agencia", 70
.Add , , "Cliente", 95
.Add , , "Total", 50
End With
.FullRowSelect = True
.Gridlines = True
.LabelEdit = 1
.ListItems.Clear
.View = lvwReport
With ThisWorkbook.Worksheets("BD")
.Activate
vUltimaLinha = .Range("A65535").End(xlUp).Row
TabelaTemp = .Range(.Cells(2, 1), .Cells(vUltimaLinha, 4)).Value
.Range("A1").Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
X = 1
TotalCol = 0
For L = 1 To UBound(TabelaTemp, 1)
If Format(CDate(TabelaTemp(L, 1)), "mmmm") = Me.cbxMESES.Value Then
.ListItems.Add , , TabelaTemp(L, 1)
.ListItems(X).ListSubItems.Add , , TabelaTemp(L, 2)
.ListItems(X).ListSubItems.Add , , TabelaTemp(L, 3)
.ListItems(X).ListSubItems.Add , , TabelaTemp(L, 4)
TotalCol = TotalCol + TabelaTemp(L, 4)
X = X + 1
End If
Next L
End With
Me.TotListView.Value = TotalCol
'TOTAL
With Me.txtTotal
Me.txtTotal = ListView1.ListItems.Count - 0
End With
End Sub

Sub AdicionaItem()
With Me.ListView1
.ListItems.Clear
With .ColumnHeaders
.Clear
.Add , , "Data", 50
.Add , , "Agencia", 70
.Add , , "Cliente", 95
.Add , , "Total", 50
End With
.FullRowSelect = True
.Gridlines = True
.LabelEdit = 1
.ListItems.Clear
.View = lvwReport
With ThisWorkbook.Worksheets("BD")
.Activate
vUltimaLinha = .Range("A65535").End(xlUp).Row
TabelaTemp = .Range(.Cells(2, 1), .Cells(vUltimaLinha, 4)).Value
.Range("A1").Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
X = 1
TotalCol = 0
For L = 1 To UBound(TabelaTemp, 1)
If TabelaTemp(L, 2) = Me.cbxAGENCIA.Value Then
If Format(CDate(TabelaTemp(L, 1)), "mmmm") = Me.cbxMESES.Value Then
.ListItems.Add , , TabelaTemp(L, 1)
.ListItems(X).ListSubItems.Add , , TabelaTemp(L, 2)
.ListItems(X).ListSubItems.Add , , TabelaTemp(L, 3)
.ListItems(X).ListSubItems.Add , , TabelaTemp(L, 4)
TotalCol = TotalCol + TabelaTemp(L, 4)
X = X + 1
End If
End If
Next L
End With
'TOTAL
Me.TotListView.Value = TotalCol
With Me.txtTotal
Me.txtTotal = ListView1.ListItems.Count - 0
End With
End Sub

Private Sub cmdFECHAR_Click()
Unload Me
End Sub

Private Sub UserForm_initialize()
cbxAGENCIA.RowSource = "Lista!A2: A10"
cbxMESES.RowSource = "Lista!B2: B13"
End Sub

'IMPRESSAO
Private Sub cmdImprimer_Click()
vLin = 1
With Me.ListView1
For I = 1 To .ListItems.Count
vLin = vLin + 1
Sheets("Impressao").Cells(vLin, 1) = .ListItems(I)
Sheets("Impressao").Cells(vLin, 2) = .ListItems(I).ListSubItems(1)
Sheets("Impressao").Cells(vLin, 3) = .ListItems(I).ListSubItems(2)
Sheets("Impressao").Cells(vLin, 4) = .ListItems(I).ListSubItems(3)
Next I
End With
MsgBox "dados imprimidos com sucesso folha impressao", vbInformation, "Escola Saberexcel VBA Estudos®"
'sbx_impressao
'sbx_limpar_Impressao
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.



.