Home Excel - Downloads / Areas Restritas Excel VBA - Userforms e outros

Excel VBA - Userforms e outros

  • - Acesso Livre
  • Documentos

    Ordenar por : Nome | Data | Acessos [ Ascendente ]

    Excel vba usf botao autofiltro oculta plan e colunas Excel vba usf botao autofiltro oculta plan e colunas

    popular!
    Adicionado em: 05/03/2011
    Modificado em: 05/03/2011
    Tamanho: Vazio
    Downloads: 1191



    Esses procedimentos e macros do Aplicativo Microsoft Excel VBA(Visual Basic Application), oculta e ou mostra determinada folha de planilha,
    como também determinadas Colunas. Observe que muda o caption e a cor do commandbutton no usf(userform), conforme a o procedimento,
    o procedimento verifica o caption do botão e status da planilha se está ou não oculta, para não perder o caption do commandbutton,
    também a propriedade AllowFiltering:=True, veja abaixo a explicação, essa propriedade é para que o autofiltro funcione com a planilha protegida.
    Veja abaixo explicação Microsoft.



    Private Sub CommandButton12_Click()

    Dim vPlanilha As Worksheet
    For Each vPlanilha In ThisWorkbook.Worksheets
    If vPlanilha.Name <> "" Then vPlanilha.Unprotect ""
    Next

    With Sheets("1").Range("D1:J1").EntireColumn
    .Hidden = Not .Hidden
    If .Hidden Then CommandButton12.Caption = "Visível" Else CommandButton12.Caption = "Invisível "
    End With

    If Sheets("2").Visible = True Then
    Sheets("2").Visible = False
    Saber3.Shapes("sb").Visible = False
    Else
    Sheets("2").Visible = True 'planilha referenciada pelo nome da folha de planilha
    Saber3.Shapes("sb").Visible = True 'planilha referenciada pelo nome da folha de código da folha de planilha
    End If

    For Each vPlanilha In ThisWorkbook.Worksheets
    If vPlanilha.Name <> "" Then vPlanilha.Protect "", _
    DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowSorting:=True, AllowFiltering:=True
    Next
    Unload frmMENU
    End Sub

    Private Sub UserForm_Initialize()
    'ao inicializar verifica se as células D1:J1, estão ocultas para o correto caption do botão
    If Sheets("1").Range("D1:J1").EntireColumn.Hidden Then
    CommandButton12.Caption = "Visível"
    CommandButton12.BackColor = vbGreen
    CommandButton12.ForeColor = &H80000012
    Else
    CommandButton12.Caption = "Invisível"
    CommandButton12.BackColor = vbRed
    CommandButton12.ForeColor = &HFFFFFF
    End If
    End Sub


    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos SaberExcel

     

    Excel vba texto derroulante exemplo objeto webBowse Excel vba texto derroulante exemplo objeto webBowse

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

     

     

     

    Excel vba planilhas usf objetos labels movemouse Excel vba planilhas usf objetos labels movemouse

    popular!
    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

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





    Excel vba planilha usf textboxes limpar todas Excel vba planilha usf textboxes limpar todas

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




    Excel vba planilha ListView busca dados soma valores Excel vba planilha ListView busca dados soma valores

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



    .

    Página 6 de 10

    PROMOÇÃO DIDÁTICOS SABEREXCEL



    Adquira já o Acesso Imediato
    à Area de Membros

    Compra Grantida --- Entrega Imediata

    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


    Pesquisa Google SaberExcel

    Publicidade Google

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

    Publicidade

    RSFirewallProtected


    Google Associados

    Depoimentos

    Adicione Saberexcel Favoritos

     
     

    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

    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