Adicionado em: | 15/04/2013 |
Modificado em: | 15/04/2013 |
Tamanho: | Vazio |
Downloads: | 643 |
Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções
Esses macros do Aplicativo Microsoft excel VBA, insere um texto derroulante com auxilio de Objeto WebBrowse,
com cores de fundo e fonte predeterminadas, há uma folha de planilha no exemplo abaixo, que traz o números das cores
HexaDecimais "#FFFF00"(Amarelo), com 256 para você praticar e observar os resultados.
Também fiz o que nossa colaboradora nos pediu uma autonumeração sequencial em (linhas e também Colunas)
no macro inseri uma condição if que verifica se o valor da célula é para ou impar e inser uma formatação condicional nas
cores da fonte para impares e pares. Espero que o exemplo possa ajuda-la. (Resposta para Arlete) - BH.
Fique com Deus,
Expedito Marcondes
Sub sbx_WebBrowse()
Const vTexto = "Escola Saberexcel VBA Estudos® - Treinamento com Macros, Fórmulas e Funções"
Const vSite = "http://www.microsoftexcel.com.br/"
Dim xTexto As String
FonteCor = "#FFFF00"
FonteCor1 = "#FFFFFF"
With UserForm1
Saber1.WebBrowser1.Navigate _
"about:<html><body BGCOLOR ='#666600' scroll='no'><font color= " & FonteCor & _
" size='5' face='Arial'>" & _
"<marquee>" & vTexto & "</marquee></font></body></html>"
Saber1.WebBrowser2.Navigate _
"about:<html><body BGCOLOR ='#003300' scroll='no'><font color= " & FonteCor1 & _
" size='4' face='Arial'>" & _
"<marquee>" & vSite & "</marquee></font></body></html>"
End With
Application.StatusBar = ""
End Sub
Sub sbx_autonumeracao_linha()
Dim vLin, vCol, tNum As Long
tNum = 1
For vLin = 11 To 22
For vCol = 2 To 9
Cells(vLin, vCol).Value = tNum
tNum = tNum + 1
If Cells(vLin, vCol).Value Mod 2 = 0 Then
Cells(vLin, vCol).Font.ColorIndex = 3
Else
Cells(vLin, vCol).Font.ColorIndex = 10
End If
Next vCol
Next vLin
End Sub
'Auto_Numeração sequencial em Colunas
Sub sbx_autonumeracao_coluna()
Dim vLin, vCol, tNum As Long
tNum = 1
[b11:i22].Font.ColorIndex = 1
For vCol = 2 To 9
For vLin = 11 To 22
Cells(vLin, vCol).Value = tNum
tNum = tNum + 1
If Cells(vLin, vCol).Value Mod 2 = 0 Then
Cells(vLin, vCol).Font.ColorIndex = 3
Else
Cells(vLin, vCol).Font.ColorIndex = 10
End If
Next vLin
Next vCol
End Sub
Sub sbx_limpar_teste()
[b11:i22].ClearContents
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.
Adicionado em: | 31/03/2013 |
Modificado em: | 31/03/2013 |
Tamanho: | Vazio |
Downloads: | 3407 |
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.
.
Adicionado em: | 26/11/2012 |
Modificado em: | 26/11/2012 |
Tamanho: | Vazio |
Downloads: | 1140 |
Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções
Esse procedimento do Aplicativo Microsot Excel VBA(Visual Basic Application), mostra um objeto TextBox e acompanha
o Cursor de acordo com a célula selecionada, aproveitei também para incrementar o exemplo adicionando um objeto Image
do VBA.
Questão proposta: e Respondida
Objeto textbox e imagem(Saberexcel) acompanha o cursor:
Prezado Marcondes
Preciso de um macro que ao usuario clicar em determinada célula,
um objeto TextBox acompanhe o cursor na folha de planilha, por
exemplo uma coluna a direita do cursor(Celula) Ativa.
Se puder ajudar, sou-lhe muito grato.
(***) gostei muito do Curso Completo MS Excel VBA.
João B. S. F. - Jundiai - SP
RESp: Prezado Amigo João Batista, Obrigado,
Fiz um macro para simulando sua necessidade, Na célula(D1), inseri uma condição,
se Celula(D1) for igual 1 mostra a Textbox e acompanha durante a digitação.
Isso você poderá inserir a condição desejada, intervalo de linhas, resultado de uma totalização de dados, ou data especifica, ou diferença datas,
ao selecionar determinada area servindo como um alerta,
Espero que seja isso que esteja precisando,
Fique com Deus,
Expedito Marcondes
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set vRegiao = Range("c8:g17")
If Not Intersect(Target, vRegiao) Is Nothing Then
If Range("d5").Value = 1 Then
Shapes("TextBox1").Visible = True
Shapes("Image1").Visible = True
Shapes("TextBox1").Left = Target.Offset(0, 1).Left
Shapes("TextBox1").Top = Target.Offset(1, 0).Top
Shapes("Image1").Left = Target.Offset(0, 5).Left
Shapes("Image1").Top = Target.Offset(1, 0).Top
Else
Shapes("TextBox1").Visible = False
Shapes("Image1").Visible = False
End If
Else
Shapes("TextBox1").Visible = False
Shapes("Image1").Visible = False
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.
Baixe o exemplo de planiha contendo os macros acima: <<< Registre-se em nosso Site >>>
Adicionado em: | 05/04/2012 |
Modificado em: | 05/04/2012 |
Tamanho: | Vazio |
Downloads: | 760 |
Escola Saberexcel VBA Estudos - Treinamentos com Macros, Fórmulas e Funções
Esses procedimentos do aplicativo Microsoft Excel VBA(Visual Basic Application), objetos userforms e Labels, frame, que mudam de cores
afetados pelo evento Mouse_Mouse.
Espero que gostem do exemplo, que possa lhe ser útil. Fique com Deus,
Expedito Marcondes - Curso Microsoft Excel VBA - vídeos de Treinamento Microsoft Excel VBA
'- - - - - - - - - - - - - - - - - - -'
Private Sub Frame1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
For Each Control In Frame1.Controls
Control.BorderStyle = 0
Control.ForeColor = &H0&
Next Control
End Sub
'- - - - - - - - - - - - - - - - - - -'
Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Frame1.BorderStyle = 1
For Each Control In Frame1.Controls
Control.BorderStyle = 0
Next Control
End Sub
'- - - - - - - - - - - - - - - - - - -'
Private Sub Label1_Click()
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
'- - - - - - - - - - - - - - - - - - -'
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label1.BorderStyle = 1
Frame1.Caption = "Selecionou Macros"
Frame1.ForeColor = &HFF&
Label1.ForeColor = &HFF0000
Label2.ForeColor = &H80000012
Label3.ForeColor = &H80000012
Label4.ForeColor = &H80000012
UserForm1.Caption = "Aprenda tudo sobre Fórmulas - Escola SaberExcel"
End Sub
'- - - - - - - - - - - - - - - - - - -'
Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label2.BorderStyle = 1
Label2.ForeColor = &HFF0000
Label1.ForeColor = &H80000012
Label3.ForeColor = &H80000012
Label4.ForeColor = &H80000012
Frame1.Caption = "Selecionou Treinamentos "
Frame1.ForeColor = &H80&
UserForm1.Caption = "Aprenda tudo sobre Funções - Escola SaberExcel"
End Sub
'- - - - - - - - - - - - - - - - - - -'
Private Sub Label3_Click()
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/index.php/curso-completo-microsoft-excel-vba.html", , True
End If
End Sub
'- - - - - - - - - - - - - - - - - - -'
Private Sub Label3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label3.BorderStyle = 1
Label3.ForeColor = &HC0&
Label1.ForeColor = &HFF0000
Label2.ForeColor = &H80000012
Label4.ForeColor = &H80000012
Frame1.Caption = "Selecionou Cursos Saberexcel"
Frame1.ForeColor = &HFF0000
UserForm1.Caption = "Aprenda tudo sobre Macros - Escola Saberexcel"
Label1.ForeColor = &H80000012
Label2.ForeColor = &H80000012
End Sub
'- - - - - - - - - - - - - - - - - - -'
Private Sub Label4_Click()
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
'- - - - - - - - - - - - - - - - - - -'
Private Sub Label4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label4.BorderStyle = 1
Label4.ForeColor = &H8000&
Label1.ForeColor = &H80000012
Label2.ForeColor = &H80000012
Label3.ForeColor = &H80000012
Frame1.Caption = "Selecionou Curso Completo com Video-Aulas (SaberExcel)"
Frame1.ForeColor = &H8000&
UserForm1.Caption = "Aprenda Microsoft Excel VBA - Escola Saberexcel"
Label3.ForeColor = &H80000012
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.
Adicionado em: | 16/02/2012 |
Modificado em: | 16/02/2012 |
Tamanho: | Vazio |
Downloads: | 860 |
Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções
Esses procedimentos (macros) do aplicativo Microsoft Excel VBA(Visual Basic Application), limpa todos objetos Textboxes de um determinado objeto Userform, observe que poderá também usar o código, fazer um macro para também limpar os objetos textboxes quando chamados.
Espero que o exemplo possa lhe ser útil. Fique com Deus, Expedito Marcondes.
Private Sub CommandButton1_Click()
Dim T As Control
TextBox1.SetFocus
For Each T In UserForm1.Controls
If TypeName(T) = "TextBox" Then
T.Value = ""
End If
Next Z
End Sub
Private Sub CommandButton2_Click()
limpar_todos_textoboxes
MsgBox ("textbox foram limpados com macros"), vbInformation, "Saberexcel"
TextBox1.SetFocus
End Sub
Private Sub Label1_Click()
Unload Me
UserForm2.Show
End Sub
Private Sub UserForm_Initialize()
TextBox1.SetFocus
End Sub
'- - - - - - - - - - - - - - - - - - - - - - - -
veja o macro que voce poderá fazer para chamar a partir de um módulo comum
para diversos userforms.
Sub limpar_todos_textoboxes()
Dim T As Control
UserForm1.TextBox1.SetFocus
For Each T In UserForm1.Controls
If TypeName(T) = "TextBox" Then
T.Value = ""
End If
Next T
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.
Adquira já o Acesso Imediato
à Area de Membros
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
<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>
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