Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

Views

Donativo

Minimizando a aplicação - Mostrando somente um Formulário - Hiding/Minimizing Excel and only displaying UserForm


Sabe como é: Aplicações profissionais requerem alguns cuidados como o de deixar a estação de trabalho livre para a utilização do usuário.

Especialmente quando nossas aplicações tratarão de processos demorados, não fará sentindo deixar a máquina totalmente estagnada. Assim podemos usar alguns recursos para permitir que o usuário continue usufruindo a máquina em outras atividades.

Uma dessas técnicas é minimizar a aplicação e deixar um pequeno formulário indicando o posicionamento sobre a fase em andamento. Isso o manterá informado e ao mesmo tempo permitirá seu livre acesso a outros processos e demandas.

Ahh tá bom, mas como faço isso?

Seguem alguns exemplos para experimentar e escolher:


1º EXEMPLO

Sub RunUserForm()

     Let Application.WindowState = xlMinimized

     UserForm1.Show


End Sub


2º EXEMPLO

Private Sub Workbook_Open()

     Let Application.WindowState = xlMinimized

     DataReductionForm.Show

     Let Application.WindowState = xlMaximized

End Sub




3º EXEMPLO


Private Sub UserForm_Initialize()
     Let Application.WindowState = xlNormal
     Let Application.Width = Me.Width
     Let Application.Height = Me.Height
End Sub


4º EXEMPLO

Private Sub Workbook_Open()
     Let Application.WindowState = xlMinimized

     UserForm1.Show vbModeless

End Sub


5º EXEMPLO

Sub Workbook_BeforeClose(Cancel As Boolean)

     Let Application.Visible = True

End Sub

Private Sub Workbook_Open()

     If ThisWorkbook.ReadOnly = True Then
          Let Application.Visible = False

          CBReq.Show
     End If

End Sub


6º EXEMPLO

Private Sub UserForm_Activate()
     Let Application.Left = Me.Left
     Let Application.Top = Me.Top
     Let Application.Width = Me.Width - 100
     Let Application.Height = Me.Height - 100
End Sub

Private Sub UserForm_Layout()
     Let Application.Left = Me.Left
     Let Application.Top = Me.Top

End Sub

Envie comentários e sugestões. Compartilhe este artigo! 
⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 


⬛◼◾▪ CONTATO ▪

Classificando os Dados de uma Planilha - Alphabetizing a Column


Você já precisou classificar os dados de uma planilha, seja para facilitar a pesquisa, seja preparar uma análise prévia?

E se você tivesse uma função disponível para isso?
(Perceba que existem outras funções utilizadas no código, mas todas estão aqui no Blog)


Function SortColumn (nSheet As String, nCellStart As String)
    ' © 2007-20 A&A - In Any Place®, except where noted, all rights reserved.
    ' THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT
    ' LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
    ' Feel free to use the code as you wish but kindly keep this header section intact.
    ' Copyright© A&A - In Any Place®, all Rights Reserved.    '      Author: André Bernardes
    '     Contact: andreluizbernardess@gmail.com | https://goo.gl/EUMbSe/
    ' Description: Sort by column.

    Dim nRowIni As String
    Dim nRowFin As String
    Dim nColIni As String
    Dim nColFin As String
    Dim nRng As String

    Let nRowIni = Range(nCellStart).Row                         ' A partir da referência (nCellStart), determina a linha inicial.
    Let nColIni = ColumnLettersFromRange (Range(nCellStart))     ' A partir da referência (nCellStart), determina a coluna inicial.
    Let nRowFin = FindingLastRow (nSheet, nColIni)               ' A partir da referência (nSheet), determina a última linha.
    
    Sheets(nSheet).Select

    Let nColFin = FindLastColumn (False)                         ' A partir da referência (nSheet), determina a última linha.
    Let nRng = nColIni & nRowIni & ":" & nColFin & nRowFin      ' A partir das referências (nSheet e nCellStart) e algumas funções, determina o range.

    Range(nCellStart).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets(nSheet).Sort.SortFields.Clear

    With ActiveWorkbook.Worksheets(nSheet).Sort
        .SetRange Range(nRng) 
        
        Let .Header = xlYes
        Let .MatchCase = False
        Let .Orientation = xlTopToBottom
        Let .SortMethod = xlPinYin
        
        .Apply
    End With

End Function

⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

⬛◼◾▪ CONTATO ▪

Retornando LETRAS a partir do número de Posicionamento de uma Coluna


Uma função simples para retornar as letras que correspondem a um número retornando a coluna.


Function ColumnLettersFromRange (rInput As Range) As String
    ' © 2007-20 A&A - In Any Place®, except where noted, all rights reserved.
    ' THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT
    ' LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
    ' Feel free to use the code as you wish but kindly keep this header section intact.
    ' Copyright© A&A - In Any Place®, all Rights Reserved.    '      Author: André Bernardes
    '     Contact: andreluizbernardess@gmail.com | https://goo.gl/EUMbSe/
    ' Description: Retorna a letra da coluna de um Range
    
    Let ColumnLettersFromRange = Split(rInput.Address, "$")(1)
End Function


⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

⬛◼◾▪ CONTATO ▪

Qual é a Última Coluna da Planilha?


Em vários momentos tentamos determinar qual é a última coluna de uma planilha na qual estamos implementando alguma automação. Ter uma função pronta para uso é sempre uma mão na roda.

Function FindLastColumn (nOpt As Boolean) As Variant
    ' © 2007-20 A&A - In Any Place®, except where noted, all rights reserved.
    ' THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT
    ' LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
    ' Feel free to use the code as you wish but kindly keep this header section intact.
    ' Copyright© A&A - In Any Place®, all Rights Reserved.    '      Author: André Bernardes
    '     Contact: andreluizbernardess@gmail.com | https://goo.gl/EUMbSe/
    ' Description: Determina a últma coluna.

    Dim LastColumn As Integer
    Dim ColumnLetter As String

    ' Retorna o número da coluna.
    If nOpt Then
        If WorksheetFunction.CountA(Cells) > 0 Then
            ' Procura qualquer entrada, pesquisando antes das Colunas.
            Let LastColumn = Cells.Find(What:="*", After:=[A1], _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious).Column
            
            Let FindLastColumn = LastColumn
        End If
    Else    ' Retorna a letra da coluna.
        If WorksheetFunction.CountA(Cells) > 0 Then
            ' Procura qualquer entrada, pesquisando antes das Colunas.
            Let LastColumn = Cells.Find(What:="*", After:=[A1], _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious).Column

            If LastColumn > 26 Then
                Let ColumnLetter = Chr(Int((LastColumn - 1) / 26) + 64) & _
                                   Chr(((LastColumn - 1) Mod 26) + 65)
            Else
                Let ColumnLetter = Chr(LastColumn + 64)
            End If

            Let FindLastColumn = ColumnLetter
        End If
    End If
End Function
⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

⬛◼◾▪ CONTATO ▪

Qual é a Última Linha da Planilha?


Existem várias situações onde precisamos determinar qual é a última Linha de uma planilha na qual estamos implementando alguma automação. Ter uma função pronta para uso é sempre uma mão na roda. Claro, existem diversas formas de se fazer isso.

Function FindingLastRow (nSheet As String, nColumnAnalyse As String) As Long
  ' © 2007-20 A&A - In Any Place®, except where noted, all rights reserved.
    ' THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT
    ' LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
    ' Feel free to use the code as you wish but kindly keep this header section intact.
    ' Copyright© A&A - In Any Place®, all Rights Reserved.    '      Author: André Bernardes
    '     Contact: andreluizbernardess@gmail.com | https://goo.gl/EUMbSe/
    ' Description: Different ways to find the last row number of a range
    ' SOURCE: www.TheSpreadsheetGuru.com

    Dim sht As Worksheet
    Dim LastRow As Long

    Set sht = ThisWorkbook.Worksheets(nSheet)

    ' Ctrl + Shift + End
    'Let LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

    ' Using UsedRange
    'sht.UsedRange 'Refresh UsedRange
    'Let LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row

    'Using Table Range
    'Let LastRow = sht.ListObjects("Table1").Range.Rows.Count

    'Using Named Range
    'Let LastRow = sht.Range("MyNamedRange").Rows.Count

    'Ctrl + Shift + Down (Range should be first cell in data set)
    'Let LastRow = sht.Range("D1").CurrentRegion.Rows.Count
    
    ' Retorna a última Linha da principal coluna.
    Let LastRow = Sheets(nSheet).Range(nColumnAnalyse & Rows.Count).End(xlUp).Row

    Let FindingLastRow = LastRow

End Function

⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

⬛◼◾▪ CONTATO ▪

Copiando uma Aba para outra Planilha - Copy from one workbook and paste into another



Imagine que tenha diversas planilhas, arquivos texto e acesso a algumas views e queries cujos conteúdos precisem regularmente ser usados em um único Dashboard, Book, ou Relatório onde todas as informações são reunidas e apresentadas.

Essa situação lhe parece familiar?

Agora imagine que dentre estes, 15 ou 20 sejam planilhas distintas, das quais precise abrir, copiar e colar os conteúdos, trazendo tudo para uma única planilha, que precisará ser formatada e distribuida.

E se pudesse apenas abrir e copiar as abas que importam, em todas as 20 planilhas, exportando-as para uma única planilha?

Pois bem, isso é possível e acessível. Segue:

Function ExportSheetOutWorkBook(PathName As String, FileName As String, TabTarget As String, TabSource As String)
    ' THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT
    ' LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
    ' Feel free to use the code as you wish but kindly keep this header section intact.
    ' Copyright© A&A - In Any Place®, all Rights Reserved.
    '      Author: André Bernardes
    '     Contact: andreluizbernardess@gmail.com | https://goo.gl/EUMbSe/
    ' Description: Exporta a Sheet informada para uma planilha externa.

    Dim ControlFile As String

    'Call SetMess(True, "Início da movimentação da aba " & TabSource)

    Let ControlFile = ActiveWorkbook.Name

    ' Abre o nome do arquivo.
    Workbooks.Open FileName:=PathName & FileName

    Call SetMess(True, "Início da movimentação da aba (" & TabSource & ") para planilha externa (" & PathName & FileName & ").")

    ' Vai para a aba Source.
    Windows(ControlFile).Activate
    Sheets(TabSource).Select

    ' Copia os dados.
    Sheets(TabSource).Copy After:=Workbooks(FileName).Sheets(1)

    'Call SetMess(True, "Colando dados na planilha externa (" & TabTarget & ") da planilha atual.")

    ' Ative a planilha Target.
    Windows(FileName).Activate

    ActiveWorkbook.Close SaveChanges:=True

    Call SetMess(True, "Salvando na planilha.")

    Windows(ControlFile).Activate
    
    Sheets("Automation").Select

    'Call SetMess(True, "Término da movimentação da aba " & TabTarget)

End Function

Copiar uma planilha específica na pasta ativa

Sub Copier1()
    'Replace "Sheet1" with the name of the sheet to be copied.
    ActiveWorkbook.Sheets("Sheet1").Copy _
       after:=ActiveWorkbook.Sheets("Sheet1")
End Sub

Copiar uma planilha específica na pasta ativa várias vezes

Sub Copier2()
    Dim x As Integer
    
    x = InputBox("Enter number of times to copy Sheet1")
    For numtimes = 1 To x
        'Loop by using x as the index number to make x number copies.
        'Replace "Sheet1" with the name of the sheet to be copied.
        ActiveWorkbook.Sheets("Sheet1").Copy _
           After:=ActiveWorkbook.Sheets("Sheet1")
    Next
End Sub

Copia a Planilha ativa várias vezes

Sub Copier3()
   Dim x As Integer
   
   x = InputBox("Enter number of times to copy active sheet")
   For numtimes = 1 To x
      'Loop by using x as the index number to make x number copies.
      ActiveWorkbook.ActiveSheet.Copy _
         Before:=ActiveWorkbook.Sheets("Sheet1")
         'Put copies in front of Sheet1.
         'Replace "Sheet1" with sheet name that you want.
   Next
End Sub

Copiar todas as planilhas em uma pasta de trabalho uma vez

Sub Copier4()
   Dim x As Integer

   For x = 1 To ActiveWorkbook.Sheets.Count
      'Loop through each of the sheets in the workbook
      'by using x as the sheet index number.
      ActiveWorkbook.Sheets(x).Copy _
         After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
         'Puts all copies after the last existing sheet.
   Next
End Sub

Código de exemplo para mover planilhas

Mover a planilha ativa para uma nova posição na pasta de trabalho

Sub Mover1()
    ActiveSheet.Move _
       After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
       'Moves active sheet to end of active workbook.
End Sub

Mover a planilha ativa para outra pasta de trabalho

Sub Mover2()
    ActiveSheet.Move Before:=Workbooks("Test.xls").Sheets(1)
    'Moves active sheet to beginning of named workbook.
    'Replace Test.xls with the full name of the target workbook you want.
End Sub

Mover Várias Planilhas da Pasta Ativa para Outra Pasta de Trabalho

Sub Mover3()
   Dim BkName As String
   Dim NumSht As Integer
   Dim BegSht As Integer

   'Starts with second sheet - replace with index number of starting sheet.
   BegSht = 2
   'Moves two sheets - replace with number of sheets to move.
   NumSht = 2
   BkName = ActiveWorkbook.Name
    
    For x = 1 To NumSht
      'Moves second sheet in source to front of designated workbook.
      Workbooks(BkName).Sheets(BegSht).Move _
         Before:=Workbooks("Test.xls").Sheets(1)
         'In each loop, the next sheet in line becomes indexed as number 2.
      'Replace Test.xls with the full name of the target workbook you want.
    Next
End Sub



⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

⬛◼◾▪ CONTATO ▪

Usando o VBA para Usar o Internet Explorer


Navegar usando o IE - Internet Explorer - é simples e pode ter diversas aplicabilidade interessantes. O código para fazer isso está abaixo:

Function InternetExplorerNavigate (nFrase As String)
    Dim IE As Object

    Set IE = CreateObject("InternetExplorer.Application")

    With IE
        Let .Left = 200
        Let .Top = 200
        Let .Height = 140
        Let .Width = 250
        Let .MenuBar = 0
        Let .Toolbar = 0
        Let .StatusBar = 0

        .navigate "https://youtu.be/-k6EQlZpMgA"

        Let .Visible = 1
    End With

    ' Aguarda até o término do carregamento.
    Do While IE.busy
    Loop
End Function

⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 


⬛◼◾▪ CONTATO ▪

Fazendo Buscas no Google - Excel VBA shell command to search Chrome


Este código serve para efetuarmos uma pesquisa no Google a partir do código VBA. Muitas pesquisas e ampliações podem ser executadas a partir daqui no que diz respeito a aplicabilidade.


Function GoogleSearch (nFrase As String)    

Dim ChromePath As String    
Dim search_string As String
    
Let search_string = "Amazon André Luiz Bernardes"    
Let search_string = Replace(search_string, " ", "+")
' Let ChromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"    
' Uncomment the following line and comment out previous for Windows 64 versions        

Let ChromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"

Shell ChromePath & " -url http://google.com/#q=" & search_string, vbMinimizedNoFocus    
', vbMinimizedNoFocus ' Should be defined in the global namespaceEnd

Function
⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

⬛◼◾▪ CONTATO ▪

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine