DONUT PROJECT - Use os add-ins do MS Excel e dê um salto em sua performance

DONUT PROJECT - Use os add-ins do MS Excel e dê um salto em sua performance





Ultimamente tenho recebido demandas externas, comprando add-ins e vendendo a solução a quem me solicitou sem a necessidade de desenvolver algo com o VBA

O que ganho? Tempo! E posso atender a muito mais pessoas. 

Outro aspecto relevante a considerar é o de que estes complementos permitem-me desenvolver Dashboards, Scorecards mais rapidamente.

Quando desenvolvia em VB, a cerca de mais de 14 anos, fiquei muito contente por descobrir a componentização, ou seja, a possibilidade de reutilizar códigos e componentes de terceiros. Sinto o mesmo agora através destes add-ins encontrados nas diversas 'App Stores'.

​Não há dúvida sobre como o MS Excel é uma ferramenta poderosa. No entanto, ela tem as suas limitações. E é aí que os add-ins (suplementos) entram em jogo. A Microsoft tem sido gentil o suficiente para abrir a sua base de códigos e permitir que desenvolvedores de terceiros estendam as funcionalidades do Excel. Esses suplementos tornam as análises e as manipulações de dados mais fáceis.

Abaixo disponibilizei uma lista breve, mas útil, de suplementos pagos e (principalmente) gratuitos do Excel que poderão ajudá-lo em qualquer esforço adicional que precise.

ANÁLISE DE DADOS
Apesar deste Blog ser escrito em português, sempre verifico o crescente aumento de visitações vindas de outros países, portanto é importante disponibilizar acesso às suas bases de dados 





Excel Solver é uma ferramenta clássica que exige um desempacotamento adicional. Carregar o Solver


Business intelligence - Ao ampliar o poder das PowerPivots, o Excel atende a necessidade do uso de ferramentas de inteligência de negócio.


Data Explorer é a mais nova ferramenta de análise de dados e de visualização disponível para download.


Acessar dados do Federal Reserve com o suplemento  FRED.


Obtenha dados do US Crime Ests em Data.gov.

Use o SimTools e o FormList para adicionar funções e procedimentos estatísticos, realizando simulações de Monte Carlo e Análises de Risco


Tem necessidade de fazer algumas previsões? Com este suplemento poderá usar vários métodos, incluindo forecasting média móvel, suavização exponencial, regressão e suavização exponencial dupla com um modelo para experimentar.


Necessidade de gerar alguns números aleatórios? Confira este Random Number Generator.


Se este breve artigo te deixou interessando, verifique outros add-ins pagos e gratuitos, experimente a Microsoft App Store,  Add-Ins.com, e o OzGrids.

Muitas ferramentas de análise de dados e plataformas de software têm seus próprios add-ins, como Tableau, MATLAB, e o Bloomberg por isso, se estiver trabalhando com uma plataforma semelhante é possível que seu provedor tenha um add-in para você. 

Se gosta de add-ins por favor, compartilhe este artigo com os seus amigos e marque o nosso blog para voltar periodicamente para atualizar a sua lista de coisas novas e interessantes.






André Luiz Bernardes








Inline image 1

DONUT PROJECT - VBA - Automatizando o Outlook para enviar um e-mail com anexo

DONUT PROJECT - VBA - Automatizando o Outlook para enviar um e-mail com anexo



O código a seguir pode ser usado para automatizar o Outlook a partir do Excel, Word, Access ou qualquer aplicativo VBA habilitado. Também poderia ser usado em um aplicativo VB6. Ele vai criar uma nova mensagem de e-mail e anexe o arquivo especificado. Em sua forma atual, ele irá exibir essa mensagem para que você verifique antes de clicar em Enviar, no entanto, pode ser facilmente modificado, tal como sugerido no código para enviá-lo imediatamente.

Option Explicit 
 
Sub SendMail() 
     
    Dim olApp As Outlook.Application 
    Dim olMail As Outlook.MailItem 
    Dim blRunning As Boolean 
     
     'get application
    blRunning=True 
    On Error Resume Next 
    Set olApp = GetObject(, "Outlook.Application") 
    If olApp Is Nothing Then 
        Set olApp = New Outlook.Application 
        blRunning=False 
    End If 
    On Error Goto 0 
     
    Set olMail = olApp.CreateItem(olMailItem) 
    With olMail 
         'Specify the email subject
        .Subject = "My email with attachment" 
         'Specify who it should be sent to
         'Repeat this line to add further recipients
        .Recipients.Add "name@host.com
         'specify the file to attach
         'repeat this line to add further attachments
        .Attachments.Add "c:\test.txt" 
         'specify the text to appear in the email
        .Body = "Here is an email" 
         'Choose which of the following 2 lines to have commented out
        .Display 'This will display the message for you to check and send yourself
         '.Send ' This will send the message straight away
    End With 
     
    If Not blRunning Then olApp.Quit 
     
    Set olApp=Nothing 
    Set olMail=Nothing 
     
End Sub

André Luiz Bernardes

Inline image 1

DONUT PROJECT - VBA - Outlook - Salvando todos os arquivos anexados nos e-mails

DONUT PROJECT - VBA - Outlook - Salvando todos os arquivos anexados nos e-mails




Este código é totalmente funcional. foi criado para funcionar como VB Script Outlook e não será executado corretamente se usado através VB6 ou DOT Net. 

Sub SalveTodosAnexos (objitem As MailItem)
    Dim objMessage As Object
    Dim objHighlighted As Outlook.Items
    Dim objAttachments As Outlook.Attachments
    Dim strName, strLocation As String
    Dim dblCount, dblLoop As Double

    ' If you are using this code you will need to edit this
    ' line so that it matches the location within outlook
    ' of the folder you intend to scan
    ' NOTE!! Only edit the "Personal Folders\Processing..."
     
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set fld = GetFolder("Personal Folders\Processing...")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
Set objHighlighted = fld.Items ' Tell it what to scan
    ' This is the location of the folder I want to save my attachments to
    ' You will most likely need to edit this to match the location of
    ' the folder you intend to save your attachments in.
    ' NOTE! Only edit C:\Documents and Settings\Administrator\Desktop\macro\
     
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Let strLocation = "C:\Documents and Settings\Administrator\Desktop\macro\"
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
    On Error GoTo ExitSub
    ' Check each selected item for attachments.
    ' If attachments exist, save them to the Macro
    ' folder on the Desktop.
    For Each objMessage In objHighlighted   ' For each email in the folder
     If objMessage.Class = olMail Then  ' ONLY scan emails!!
            Set objAttachments = objMessage.Attachments
            ' Now to set my loop to the amount of attachments
            ' on the current email the script is processing.
            Let dblCount = objAttachments.Count
        If dblCount <= 0 Then GoTo 100  ' If no attachments exsist
                                        ' go to the next email.
                ' I know this part looks weird...But If I counted
                ' upwards, the script was not recognizing every
                ' email and was skipping like half of them. By
                ' counting downwards, this problem is resolved.
                ' Thanks to Slovaktech.com for solving this one.
            For dblLoop = dblCount To 1 Step -1
                    ' This will be appended to the file name of each attachment to insure
                    ' that there are no duplicates, and therefor nothing gets overwritten
                    Let strID = " from " & Format(Date, "mm-dd-yy")           'Append the Date
                    Let strID = strID & " at " & Format(Time, "hh`mm`ss AMPM") 'Append the Time
                    ' These lines are going to retrieve the name of the
                    ' attachment, attach the strID to it to insure it is
                    ' a unique name, and then insure that the file
                    ' extension is appended to the end of the file name.
                    Let strName = objAttachments.Item(dblLoop).FileName 'Get attachment name
                    Let strExt = Right$(strName, 4)                     'Store file Extension
                    Let strName = Left$(strName, Len(strName) - 4)      'Remove file Extension
                    Let strName = strName & strID & strExt              'Reattach Extension
                    ' Tell the script where to save it and
                    ' what to call it
                    Let strName = strLocation & strName                 'Put it all together
                    ' Save the attachment as a file.
                    objAttachments.Item(dblLoop).SaveAsFile strName 'Save the attachment
                ' This next line DELETES the email completly.
                ' If you do not wish to delete the email
                ' change this line to read  objMessage.Save
                 
                '''''''''''''''''''
                objMessage.Delete
                '''''''''''''''''''
                 
                ' This section of code is optional. It puts a 1 second
                ' delay between file saves so that my strID is unique
                ' for EVERY file. I do this because the script does
                ' not confirm overwrites and this would be an issue for
                ' the client I am writing this for. If this is not an
                ' issue for you, just delete the entire section or
                ' simply comment it out.
                 
                ''''''''''''''''''''''''''''''''''''''''
                Dim PauseTime, Start, Finish, TotalTime
                    Let PauseTime = 1
                    Let Start = Timer
                    Do While Timer < Start + PauseTime
                    Loop
                    Let Finish = Timer
                ''''''''''''''''''''''''''''''''''''''''
                 
            Next dblLoop
         End If

    Next
ExitSub:
    Set objAttachments = Nothing
    Set objMessage = Nothing
    Set objHighlighted = Nothing
    Set objOutlook = Nothing
End Sub
 
  ' This entire section of code was provided to me by Sue.
  ' This is NOT my work and I am NOT taking credit for it.
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetFolder(FolderPath)
  ' folder path needs to be something like
  '   "Public Folders\All Public Folders\Company\Sales"
  Dim aFolders
  Dim fldr
  Dim i
  Dim objNS
  On Error Resume Next

  Let strFolderPath = Replace(FolderPath, "/", "\")
  Let aFolders = Split(FolderPath, "\")
  'get the Outlook objects
  ' use intrinsic Application object in form script
  Set objNS = Application.GetNamespace("MAPI")
  'set the root folder
  Set fldr = objNS.Folders(aFolders(0))
  'loop through the array to get the subfolder
  'loop is skipped when there is only one element in the array
  For i = 1 To UBound(aFolders)
    Set fldr = fldr.Folders(aFolders(i))
    'check for errors
    If Err <> 0 Then Exit Function
  Next
  Set GetFolder = fldr
  ' dereference objects
  Set objNS = Nothing
End Function

André Luiz Bernardes

Inline image 1

DONUT PROJECT - VBA - Criando uma Matriz de Datas MAT - Moving Annual Total

DONUT PROJECT - VBA - Criando uma Matriz de Datas MAT



Em diversas ocasiões usamos tabelas com períodos MAT, geralmente estas são extraídas de BIs (Business Information). Os cabeçalhos nem sempre são aquilo que desejaríamos usar.




Como podemos conciliar o conteúdo, adequando os títulos?



As funções abaixo lhe permitirão carregar (LoadMonths()) em uma Matriz, 12 meses, sendo o primeiro uma data passada e os próximos 11 meses serão calculados retroativamente. Depois poderão recuperar (ReturnMonth()) estas datas.

Global nMeses(12) As Date

Sub LoadMonths()
    '      Author: André Bernardes
    '        Date: 20/08/14 - 09:53
    '      Action: Cria tabelas de Regionais para análise.
    ' Application: Analysis****Regional®
    '   Test line: nMeses (1), nMeses(2), nMeses(3), nMeses(4), nMeses(5), nMeses(6), nMeses(7), nMeses(8), nMeses(9), nMeses(10), nMeses(11), nMeses(12)
    '   Test line: Debug.Print ReturnMonth(1), ReturnMonth(2), ReturnMonth(3), ReturnMonth(4), ReturnMonth(5), ReturnMonth(6), ReturnMonth(7), ReturnMonth(8), ReturnMonth(9), ReturnMonth(10), ReturnMonth(11), ReturnMonth(12)

    Dim i As Integer
    Dim Flag As Boolean
    Dim LastDate As Date

    Let Flag = True

    For i = 1 To 12
        If Flag Then
            Let nMeses(i) = Sheets("Analise").Range("I5").Value
            Let LastDate = nMeses(i)
            Let Flag = False
        Else
            Let nMeses(i) = DateAdd("m", -1, LastDate)
            Let LastDate = nMeses(i)
        End If
    Next
End Sub

Function ReturnMonth (nMnth As Integer) As String
    '      Author: André Bernardes
    '        Date: 20/08/14 - 09:53
    '      Action: Cria tabelas de Regionais para análise.
    ' Application: AnalysisMDTRRegional®
    '   Test line: nMeses (1), nMeses(2), nMeses(3), nMeses(4), nMeses(5), nMeses(6), nMeses(7), nMeses(8), nMeses(9), nMeses(10), nMeses(11), nMeses(12)
    '   Test line: Debug.Print ReturnMonth(1), ReturnMonth(2), ReturnMonth(3), ReturnMonth(4), ReturnMonth(5), ReturnMonth(6), ReturnMonth(7), ReturnMonth(8), ReturnMonth(9), ReturnMonth(10), ReturnMonth(11), ReturnMonth(12)

    Dim nMonth As String
    Dim nYear As String
    Dim nTitle01 As String

    Let nMonth = Mid(Format(nMeses(nMnth), "DD/MM/YYYY"), 4, 2)
    Let nYear = Year(nMeses(nMnth))
    Let nTitle01 = UCase(Left(Format(Month(nMonth), "mmm"), 3))

    If nMonth = "01" Then
        Let ReturnMonth = "JAN|" & nYear
    ElseIf nMonth = "02" Then
        Let ReturnMonth = "FEV|" & nYear
    ElseIf nMonth = "03" Then
        Let ReturnMonth = "MAR|" & nYear
    ElseIf nMonth = "04" Then
        Let ReturnMonth = "ABR|" & nYear
    ElseIf nMonth = "05" Then
        Let ReturnMonth = "MAI|" & nYear
    ElseIf nMonth = "06" Then
        Let ReturnMonth = "JUN|" & nYear
    ElseIf nMonth = "07" Then
        Let ReturnMonth = "JUL|" & nYear
    ElseIf nMonth = "08" Then
        Let ReturnMonth = "AGO|" & nYear
    ElseIf nMonth = "09" Then
        Let ReturnMonth = "SET|" & nYear
    ElseIf nMonth = "10" Then
        Let ReturnMonth = "OUT|" & nYear
    ElseIf nMonth = "11" Then
        Let ReturnMonth = "NOV|" & nYear
    ElseIf nMonth = "12" Then
        Let ReturnMonth = "DEZ|" & nYear
    End If
End Function

Caso queiram traduzir os meses para outros idiomas basta que alterem os meses.

André Luiz Bernardes

Inline image 1

DONUT PROJECT - VBA - Excel - Atualizando Tabelas Dinâmicas - Refresh Pivot Table via VBA

DONUT PROJECT - VBA - Excel - Atualizando Tabelas Dinâmicas - Refresh Pivot Table via VBA






Aqueles que utilizam as Tabelas Dinâmicas em alta escala têm consciência do poder que elas têm e da praticidade que trazem para os nossos projetos.

Nos códigos abaixo olharemos para algumas situações onde poderemos atualizar todas as Pivots, ou apenas Pivots escolhidas.

Atualizando uma tabela Simples

Private Sub Worksheet_Activate()

Run "PivotMacro"

End Sub

Sub PivotMacro()
Dim pt As PivotTable

Set pt = ActiveSheet.PivotTables("MyPivot")

pt.RefreshTable
End Sub

Atualizando todas asTabelas Dinâmicas da Planilha

Sub AllWorksheetPivots()

    Dim pt As PivotTable

    For Each pt In ActiveSheet.PivotTables

        pt.RefreshTable

    Next pt 

End Sub

Atualizando uma Tabelas Dinâmicas específicas
Sub ChosenPivots()

Dim pt As PivotTable

    For Each pt In ActiveSheet.PivotTables    

        Select Case pt.Name

            Case "PivotTable1", "PivotTable4", "PivotTable8"

                pt.RefreshTable

            Case Else

        End Select

    Next pt

End Sub

Atualize todas as Tabelas Dinâmicas Selecionadas
Sub AllWorkbookPivots()

Dim pt As PivotTable

Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Worksheets    

        For Each pt In ws.PivotTables

                    pt.RefreshTable

        Next pt

    Next ws
    
End Sub


André Luiz Bernardes

Inline image 1


DONUT PROJECT - VBA - Excel - Removendo os Caracteres Alfabéticos e Especiais

DONUT PROJECT - VBA - Excel - Removendo os Caracteres Alfabéticos e Especiais



'Remove All Alpha and Special characters from cell
Function Remove_AlphaSpecialChar (DataCell As Range) As String
     
    ' Declaração de Variável.
    Dim iCnt As Integer
    Dim IpData As Range
    Dim sData As String, sTmp As String
              
    If DataCell.Count <> 1 Then
        MsgBox ("Por favor, selecione uma célula"), vbInformation
        Exit Function
    End If
     
    ' Loop que checa todos os caracteres disponíveis na célula.
    For iCnt = 1 To Len(DataCell.Text)
        If Mid(DataCell.Text, iCnt, 1) Like "[0-9]" Then
            Let sData = sData & Mid(DataCell.Text, iCnt, 1)
        End If
    Next iCnt
     
    Let Remove_AlphaSpecialChar = sData
End Function