Propósito

✔ Programação GLOBAL® - Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog devem ser tratados como consultoria freelance. Queiram contatar-nos: brazilsalesforceeffectiveness@gmail.com | ESTE BLOG NÃO SE RESPONSABILIZA POR QUAISQUER DANOS PROVENIENTES DO USO DOS CÓDIGOS AQUI POSTADOS EM APLICAÇÕES PESSOAIS OU DE TERCEIROS.

.: Vitrine

Carregando artigos...

Views

Mostrando postagens com marcador Tags: VBA. Mostrar todas as postagens
Mostrando postagens com marcador Tags: VBA. Mostrar todas as postagens

Tips - Rastrei os seus Dashboards, Scorecards, Reports, Relatórios, Planilhas e Aplicações




Você deseja acompanhar quantas pessoas estão acessando as suas Planilhas, Dashboards, Scorecards, e os Relatórios disponibilizados na rede da sua empresa?

Sim, é natural que após termos tanto tempo para prepararmos um belo produto de análise, desejemos acompanhar quem o está consultando. Bem, você pode acompanhar  através de um arquivo de .LOG. 

Isso pode ser facilmente implementado por adicionarmos uma pequena função dentro da sua aplicação. Altere o código para gravar os LOGs em um diretório (ou servidor de arquivos) escondido para acompanhar mesmo que remotamente os acessos à sua aplicação. 

Private Sub Form_Open (Cancel As Integer)
' Author: Date: Contact:
' André Bernardes 18/06/2008 08:21 bernardess@gmail.com
' Sub de abertura do formulário.
' Rastreador inserido em 25.09.2008 - 10:52 
.LOG
.

Dim ThisFormName As String

Let ThisFormName = Me.Name

Call Rastrear ' Registra acesso no Log.
Call ImagesPath
Call SetMoldura("Logando à aplicação", " . . . ")

HideAccessCloseButton ' Elimina o botão fechar na janela da aplicação do Windows.

Me.LblTime.Caption = Now()

Call AssenteAcesso("OF", ThisFormName, "Sys: Splash de abertura.")
Call SetMoldura("", ".: A&A - In Any Place")
End Sub


Cole a função abaixo no seu módulo:

Function Rastrear()
' Author: Date: Contact:
' André Bernardes 25/09/2008 10:01 bernardess@gmail.com
' Cria arquivo .LOG
Open Application.CurrentProject.Path & "\" & Left(Application.CurrentProject.Name, Len(Application.CurrentProject.Name) - 4) & ".log" For Append As #1

Print #1, " "
Print #1, "User: " & atCNames(1) & "- " & Trim(atCNames(2)), Now()
Print #1, " In: " & CodeProject.FullName
Print #1, " "

Close #1
End Function

Como sei que você tem bastante imaginação, use este código para registrar todos os acessos de todas as suas aplicações MS Access, MS Excel, MS Word, MS PowerPoint, MS Outlook, etc... no mesmo arquivo .LOG, analisando-o quando desejar. Há uma infinidade de possibilidades de utilização dessa solução.Divirta-se. 


Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...


Tags: VBA, LOG, 



Nenhum comentário:
Tags: ,

VBA Excel - Retorna a Última Linha de uma planilha

Function LastRow (nColumn As String, InitLine As Single) As Single
    ' Author:                     Date:               Contact:
    ' André Bernardes             11/08/2008 09:01    bernardess@gmail.com
    ' Retorna o número de ocorrências.

    Dim nLine As Single
    Dim nStart As Single
    Dim nFinito As Single
    Dim Cabessalho As Single
    Dim nCeo As String

    Application.Volatile

    Let nStart = InitLine + 1
    Let nFinito = 65000
    Let Cabessalho = InitLine

    Do While nStart < nFinito
        Let nCeo = nColumn & Trim(Str(nStart))

        If Application.ActiveSheet.Range(nCeo).Value = "" Then
            Exit Do
        End If

        'Let Application.StatusBar.Value = " Linha: " & nStart
        Let nStart = nStart + 1
    Loop

    Let LastRow = (nStart - 1) '- Cabeçalho
    'Let Application.StatusBar.Value = "  "
End Function


brazilsalesforceeffectiveness@gmail.com


✔ Brazil SFE®Author´s Profile  Google+   Author´s Professional Profile   Pinterest   Author´s Tweets

Nenhum comentário:
Tags: , , , , , ,

VBA Excel - Retornando o Limite da Coluna de um Range



Como faço para descobrir a última coluna com dados numa Planilha?

Function LASTINCOLUMN (rngInput As Range)
    ' Author:                     Date:               Contact:
    ' André Bernardes             11/08/2008 09:01    bernardess@gmail.com
    '
    Dim WorkRange As Range
    Dim i As Integer, CellCount As Integer
    
    Application.Volatile

    Set WorkRange = rngInput.Columns(1).EntireColumn
    Set WorkRange = Intersect(WorkRange.Parent.UsedRange, WorkRange)
    
    Let CellCount = WorkRange.Count

    For i = CellCount To 1 Step -1
        If Not IsEmpty(WorkRange(i)) Then
            Let LASTINCOLUMN = WorkRange(i).Value
            Exit Function
        End If
    Next i
End Function


Tags: VBA, Excel, UDF, Column, coluna, last, última




Nenhum comentário:
Tags: , , , , , ,

VBA Excel - Interagindo com as Funções AutoFiltro - Excel List AutoFilter VBA




Seguem alguns exemplos de programação VBA para manipular o AutoFiltro do MS Excel, para uso com as listas de dados encontrados nas tabelas das nossas planilhas.

Quando nomeamos estas tabelas de dados constituimos um ListObject, o qual automaticamente recebe a sua própria propriedade AutoFiltro.


Mostrando todos os registros



O código abaixo mostra todos os registros duma lista na planilha ativa, onde um filtro foi aplicado.



Sub ShowAllRecordsList1()

' Mostra todos os registros

Dim Lst As ListObject



Set Lst = ActiveSheet.ListObjects(1)



If Lst.AutoFilter.FilterMode Then

    Lst.AutoFilter.ShowAllData

End If

End Sub


Ligando o AutoFiltro da nossa Lista


Ao usar o código a seguir, você ligará o AutoFiltro do Excel na 1ª lista da planilha ativa.

Sub TurnAutoFilterOnList1()

' Liga o AutoFiltro na 1ª lista.


Dim Lst As ListObject


Set Lst = ActiveSheet.ListObjects (1)


Let Lst.ShowAutoFilter = True

End Sub

Desligando a Lista de AutoFiltro

Utilize o código a seguir para desligar um AutoFiltro do Excel na 1ª lista da planilha ativa.

Sub TurnAutoFilterOffList1()
' Desliga o AutoFiltro na 1ª lista.

Dim Lst As ListObject

Set Lst = ActiveSheet.ListObjects(1)
  
Let Lst.ShowAutoFilter = False
End Sub 

Contando as Listas de AutoFiltros

Para contar todas as listas e tabelas nomeadas duma planilha, onde existem AutoFiltros ativos, usamos o código a seguir.


Sub CountListAutoFilters()

' Conta a Lista de AutoFiltros mesmo que todas as seta fiquem escondidas.



Dim Lst As ListObject

Dim i As Long


Let i = 0



For Each Lst In ActiveSheet.ListObjects

    If Lst.ShowAutoFilter = True Then

    Let i = i + 1

    End If

Next Lst


Debug.Print "Lista de autofiltros: " & i

End Sub

Ocultando todas as Setas da lista de AutoFiltro, exceto uma

Talvez deseje que os seus usuários filtrem apenas uma das colunas da sua primeira Lista. O procedimento VBA  a seguir, esconde as setas de todas as colunas, exceto a segunda coluna da 1ª lista.

Sub HideArrowsList1()
'hides all arrows except list 1 column 2

Dim Lst As ListObject
Dim c As Range
Dim i As Integer

Let Application.ScreenUpdating = False

Set Lst = ActiveSheet.ListObjects(1)

Let i = 1

For Each c In Lst.HeaderRowRange
 If i <> 2 Then
    Lst.Range.AutoFilter Field:=i, _
      VisibleDropDown:=False
 Else
     Lst.Range.AutoFilter Field:=i, _
      VisibleDropDown:=True
 End If

Let i = i + 1
Next

Let Application.ScreenUpdating = True
End Sub 

Ocultando Setas específicas nas listas de AutoFiltro

Talvez, em alguns casos específicos, queiramos ocultar as setas de colunas específicas na nossa lista de dados, deixando as demais setas visíveis. O código a seguir esconde as setas das colunas 1, 3 e 4 na 2ª lista.


Sub HideSpecifiedArrowsList2()
' Esconde setas (arrows) em colunas específicas na 2ª lista.

Dim Lst As ListObject
Dim c As Range
Dim i As Integer

Let Application.ScreenUpdating = False

Set Lst = ActiveSheet.ListObjects(2)

Let i = 1

For Each c In Lst.HeaderRowRange

Select Case i

Case 1, 3, 4

    Lst.Range.AutoFilter Field:=i, _

      Visibledropdown:=False

Case Else

     Lst.Range.AutoFilter Field:=i, _

      Visibledropdown:=True

End Select


Let i = i + 1

Next

Let Application.ScreenUpdating = True
EndSub

Visualizar todas as setas da Lista AutoFiltro

Para mostrar todas as setas da 1ª Lista, podemos usar o código a seguir:


Sub ShowArrowsList1()

Dim Lst As ListObject

Dim c As Range

Dim i As Integer


Let Application.ScreenUpdating = False



Set Lst = ActiveSheet.ListObjects(1)


Let i = 1



For Each c In Lst.HeaderRowRange

  Lst.Range.AutoFilter Field:=i, _

    Visibledropdown:=True

  Let i = i + 1

Next



Let Application.ScreenUpdating = True

End Sub 

Copiando Linhas filtradas específicas, sem os títulos

Este simples código copia somente as linhas filtradas, mas não os respectivos títulos.

A cópia é feita a partir da 1ª Lista na planilha ativa, para uma nova planilha.


Sub CopyFilteredRowsOnlyList1()
Dim wsL As Worksheet
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim Lst As ListObject

Let Application.ScreenUpdating = False

Set wsL = ActiveSheet
Set Lst = wsL.ListObjects(1)

With Lst.AutoFilter.Range

On Error Resume Next


Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _

       .SpecialCells(xlCellTypeVisible)

On Error GoTo 0

End With

If rng2 Is Nothing Then
   MsgBox "Sem dados para copiar."
Else
   Set ws = Sheets.Add
   Set rng = Lst.AutoFilter.Range

   ' Copia todas as linhas sem os cabeçalhos
   rng.Offset(1, 0).Resize(rng.Rows.Count - 1) _
    .SpecialCells(xlCellTypeVisible).Copy _
     Destination:=ws.Range("A1")
End If
   
Let Application.ScreenUpdating = True

End Sub

Copiando Linhas filtradas específicas, com os títulos

O código abaixo copia as linhas filtradas, e as suas respectivas posições, com os títulos.

Sub CopyFilteredRowsAndHeadingsList1()
Dim wsL As Worksheet
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim Lst As ListObject

Let Application.ScreenUpdating = False

Set wsL = ActiveSheet
Set Lst = wsL.ListObjects(1)

With Lst.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
       .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng2 Is Nothing Then
   MsgBox "Sem dados para copiar."
Else
   Set ws = Sheets.Add
   Set rng = Lst.AutoFilter.Range

   ' Copia as Linhas com os seus cabeçalhos.
   rng.SpecialCells(xlCellTypeVisible).Copy _
     Destination:=ws.Range("A1")
End If
   
Let Application.ScreenUpdating = True
End Sub

Conte as Linhas da Lista Visível

Com o exemplo do código a seguir, exibiremos uma mensagem que mostra quantas linhas estão visíveis após a aplicação do filtro:

Sub CountVisibleRowsList1()
Dim Lst As ListObject
Dim rng As Range

Set Lst = ActiveSheet.ListObjects(1)
Set rng = Lst.AutoFilter.Range

MsgBox rng.Columns(1). _
   SpecialCells(xlCellTypeVisible).Count - 1 _
   & " of " & rng _

   .Rows.Count - 1 & " Registros"
End Sub

Tags: VBA, Excel, List, AutoFilter, autofiltro, funções, autofiltro, listobject,  Worksheet , 


Nenhum comentário:
Tags: , , , , , , ,
Assinar: Postagens (Atom)
diHITT - Notícias