Views

...

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.

E-mails

Deixe seu e-mail para receber atualizações...

eBook Promo

Mostrando postagens com marcador range. Mostrar todas as postagens
Mostrando postagens com marcador range. Mostrar todas as postagens

Fórmula Excel - Detectando o Número Máximo de Ocorrências de uma mesma String Num Range

Excel VBA - Detectando o Número Máximo de Ocorrências de uma mesma String Num Range


Esta função do Excel encontra e conta o número de ocorrências repetitivas de uma string dentro de um Range:


{ =INDEX($A$2:$A$16,MATCH(MAX(COUNTIF($A$2:$A$16,$A$2:$A$16)),COUNTIF ($A$2:$A$16,$A$2:$A$16),0)) }

Esta é uma fórmula de matriz, de modo que precisaremos usar a combinação de teclas 'Ctrl' + 'Shift' + 'Enter' depois de digitar a fórmula para obter o resultado. E isso também funciona com números.

Deixe seus comentários, COMPARTILHE este artigo!


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

⬛◼◾▪ Blogs ▪◾◼⬛ 

⬛◼◾▪ CONTATO ▪

VBA Excel Intermediário - Exportando DOIS Ranges Simultaneamente para o PowerPoint

VBA Excel Intermediário - Exportando DOIS Ranges Simultaneamente para o PowerPoint



Sim, caso nosso Dashboard seja grande demais, ou tenha pequenas partes que gostaria de destacar durante a sua apresentação, talvez decida exportar pequenas partes em slides separados, logo após tê-los exportado juntos.

Ter a liberdade de poder efetuar essa exportação com a mesma funcionalidade técnica é sempre uma bem recebida solução para a nossa correria do dia a dia.

Um plus+ neste código é o que verá no arremate da colagem da imagem, quando o script tenta adequar o tamanho da imagem ao slide onde está sendo colado. 

Começa assim:

    Dim nTitle As String
    Dim nRngName01 As String

    Dim nRngName02 As String

     Let nRngName01 = "TOP"
     Let nRngName02 = "BODY"

     Let nTitle = ActiveSheet.Range("AB9").Value

    Call XPortRng2PPT (nRngName01, nRngName02, nSheetName, nTitle)

Continue assim:

Sub XPortRng2PPT (nRngName01 As String, nRngName02 As String, nSheet As String, nTitle As String)
    '      Author: André Luiz Bernardes - A&A - In Any Place - andreluizbernardes@gmail.com
    '        Date: 01/06/2016 - 10:32
    ' Application: Field Force Dashboard Analysis® 
    '     Purpose: Copy/Paste An Excel Range Into a New PowerPoint Presentation

    Dim ActFileName As Variant
    Dim ScaleFactor As Single

    On Error GoTo ErrorHandling

    Let ActFileName = Application.GetOpenFilename("Microsoft PowerPoint-Files (*.pptx), *.ppt")
    Let ScaleFactor = Range("myScaleFactor").Value

    Application.Sheets(nSheet).Select

    Set PP = CreateObject("Powerpoint.Application")

    If ActFileName = False Then
        PP.Activate
        PP.Presentations.Add
        Set PP_File = PP.ActivePresentation
    Else
        PP.Activate
        Set PP_File = PP.Presentations.Open(ActFileName)
    End If

    Let PP.Visible = True

    CopyandPastetoPPT nRngName01, nTitle, ScaleFactor, ScaleFactor
    CopyandPastetoPPT nRngName02, nTitle, ScaleFactor, ScaleFactor

    Set PP_Slide = Nothing
    Set PP_File = Nothing
    Set PP = Nothing

    Application.Sheets(nSheet).Activate
Exit Sub

ErrorHandling:

Set PP_Slide = Nothing
Set PP_File = Nothing
Set PP = Nothing

MsgBox "Error No.: " & Err.Number & vbNewLine & vbNewLine & "Description: " & Err.Description, vbCritical, "Error"

End Sub

Sub CopyandPastetoPPT (myRangeName As String, _
                              myTitle As String, _
                              myScaleHeight As Single, _
                              myScaleWidth As Single)
    '      Author: André Luiz Bernardes - A&A - In Any Place - andreluizbernardes@gmail.com
    '        Date: 01/06/2016 - 10:32
    ' Application: Field Force Dashboard Analysis®
    '     Purpose: Copy/Paste.

    Dim NextShape As Integer

    Application.GoTo Reference:=myRangeName

    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
    Range("A1").Select

    PP.ActivePresentation.Slides.Add PP.ActivePresentation.Slides.Count + 1, 11

    Set PP_Slide = PP_File.Slides(PP.ActivePresentation.Slides.Count)
    Let PP_Slide.Shapes.Title.TextFrame.TextRange.Text = myTitle
    Let NextShape = PP_Slide.Shapes.Count + 1

    PP_Slide.Shapes.PasteSpecial 2
    
    PP_Slide.Shapes(NextShape).ScaleHeight myScaleHeight, 1
    PP_Slide.Shapes(NextShape).ScaleWidth myScaleWidth, 1
    PP_Slide.Shapes(NextShape).Left = PP_File.PageSetup.SlideWidth \ 2 - PP_Slide.Shapes(NextShape).Width \ 2
    PP_Slide.Shapes(NextShape).Top = 90

End Sub


Se gostou, compartilhe este post com outros! Deixe seus comentários e sugestões.










VBA Excel Intermediário - Exportando um Range para o PowerPoint

VBA Excel Intermediário - Exportando um Range para o PowerPoint











Exportar um range específico do nosso Dashboard diretamente para o MS Powerpoint deixou de ser um grande segredo e tornou-se a funcionalidade mais usada entre aqueles que conhecem um pouco de VBA. Por isso disponibilizo mais uma versão dessa possibilidade:

Sub ExcelRangeToPowerPoint(nSheet As String, NewPPT As Boolean, nRng As String, nLeft As Integer, nTop As Integer)
    '      Author: André Luiz Bernardes - A&A - In Any Place - andreluizbernardes@gmail.com
    '        Date: 11/05/2016 - 12:25
    ' Application: Field Force Dashboard Analysis®
    '     Purpose: Copy/Paste An Excel Range Into a New PowerPoint Presentation

Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object

'Copy Range from Excel
  Set rng = Sheets(nSheet).Range(nRng) 'ThisWorkbook.ActiveSheet.Range(nRng)

'Create an Instance of PowerPoint
  On Error Resume Next
    
    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    
    'Clear the error between errors
      Err.Clear

    'If PowerPoint is not already open then open PowerPoint
      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    
    'Handle if the PowerPoint Application is not found
      If Err.Number = 429 Then
        MsgBox "PowerPoint não pôde ser aberto, abortando exportação."
        Exit Sub
      End If

  On Error GoTo 0

'Optimize Code
  Application.ScreenUpdating = False

'Create a New Presentation
  Set myPresentation = PowerPointApp.Presentations.Add

'Add a slide to the Presentation
  Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly

'Copy Excel Range
  rng.Copy

'Paste to PowerPoint and position
  mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
  Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
  
    'Set position:
      myShape.Left = nLeft
      myShape.Top = nTop

'Make PowerPoint Visible and Active
  PowerPointApp.Visible = True
  PowerPointApp.Activate

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub



Se gostou, compartilhe este post com outros! Deixe seus comentários e sugestões.










VBA Excel Basic - Copiando um Range de Planilha para Planilha - Copy a range in an Excel sheet using vba



Sub Copy_Data()
Let Application.ScreenUpdating = False

Let Worksheets("Plan01").Range("B2:Y34").Value = ActiveSheet("Plan02").Range("B2:Y34").Value

Let Application.ScreenUpdating = True
End Sub

Outro modo de fazer a mesma coisa:

Sub Macro1()
  Range("B2:Y34").Select

  Selection.Copy

  Sheets("Sheet5").Select

  Range("B2").Select

  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,    SkipBlanks:=False, Transpose:=False
End Sub

Copiando uma coluna:

Sheets("Temp").Columns(1).Copy

Sheets("Overview").Range("C40").PasteSpecial



Tags: VBA, Excel, Range, Planilha, Copiar, Copy, 


VBA Excel - Barra de Status Informativa - Info Status Bar


Podemos aumentar  a quantidade de visualizações sobre o que estamos fazendo, colocando detalhes na nossa Barra de Status do MS Excel. Chamaremos este exemplo de INFO STATUS BAR.

Antes de continuar, um pequeno parênteses, deixe seus comentários para este post. 

Como sempre fazemos, é bom lembrar que este exemplo de código serve para que possamos ampliar a nossa visão sobre como utilizar outras informações muito mais úteis do que estas na Barra de Status, fica o exemplo!

Ahhh, e faremos passo a passo para incluir os iniciantes.

Início
Já percebeu que ao selecionarmos um range de células, não conseguimos observar o range selecionado na  
'Name Box'? (Veja abaixo)


Tampouco, observamos este Range na Barra de Status.


PASSO 01
Com o intuito de inserirmos um código que possa demonstrar o que selecionamos, vá para o VBE (pressione Alt + F11), e então dê umduplo clique em 'EstaPasta_de_trabalho(ou 'ThisWorbook' se a sua versão do MS Office estiver em inglês).



PASSO 02
Ao lado direito, na área do editor, copie e cole o código abaixo:

Private Sub Workbook_SheetSelectionChange
(ByVal Sh As Object, ByVal Target As Range)
    ' Author                        Contact                        Place
    ' André Luiz Bernardes          bernardess@gmail.com          http://inanyplace.blogspot.com/
    ' Mostra as células que foram marcadas na barra de status.
    
    Dim cCell As Variant, i As Range
  
    For Each i In Selection.Areas
        Let cCell = cCell + CDec(i.Rows.Count) * i.Columns.Count
    Next

    Let Application.StatusBar = Replace(Selection.Address(0, 0) & " selecionadas (" & cCell & Left(" Célula(s)", 11 + (cCell = 1)) & ")", ",", ", ")
End Sub


PASSO 03
Agora quando selecionar qualquer parte da planilha, sempre observará algo similar a isso:


Muito bem, o exemplo acabou aqui. Mas lembre-se, este foi apenas uma aplicabilidade para a utilização da Barra de Status. Colocarei outras aplicações abaixo para que continue se exercitando:

Exemplo 01
Se você, no código VBA, desligou a atualização da tela, e seus códigos levarem algum tempo para processar, o usuário pode pensar que o computador parou de responder. Por isso, uma boa regra de programação é informar ao usuário sobre a evolução do processamento, exibindo [no mínimo] uma mensagem na Barra de Status na parte inferior da tela.

Sub StatusBarSample()
    Let Application.ScreenUpdating = False 
    ' Desliga a atualização da tela.
    
    ' Certifica-se de que a Barra de Status estará funcional.
    Let Application.DisplayStatusBar = True    
    Let Application.StatusBar = "Por favor, aguarde a execução da 1ª Parte..."

    ' No ponto abaixo, algum código é adicionado para o processamento.
    Application.Wait Now + TimeValue("00:00:02")
    Let Application.StatusBar = "Aguarde a execução da 2ª Parte..."
    
    ' Adicione algum código para o processamento da 2ª Fase.
    Application.Wait Now + TimeValue("00:00:02")
    Let Application.StatusBar = False 
End Sub

Exemplo 02
Você tem um processo que leva algum tempo para ser executado. Talvez uns 30 segundos, talvez 10 minutos. De qualquer forma você quer que o usuário saiba que a macro está sendo executado e em que parte do processe está:

Sub StatusBar()
    ' Author                        Contact                        Place
    ' André Luiz Bernardes          bernardess@gmail.com           http://inanyplace.blogspot.com/
    ' Efetua um contador.
         
    Dim x               As Integer
    Dim MyTimer         As Double
     
    Let Application.StatusBar = True
    
    ' Adapte este loop se for necessário.
    For x = 1 To 250
        Let MyTimer = Timer
        
        Do
        Loop While Timer - MyTimer < 0.03
         
        Application.StatusBar = "Progresso: " & x & " de 250: " & Format(x / 250, "Percent")
        
        DoEvents
    Next x
     
    Let Application.StatusBar = False
End Sub

Tags: Barra de Status, Bernardes, Excel, information, iniciantes, Microsoft, MS, Office, range, select, Status, Status Bar, VBA





VBA Excel - Excluir linhas em branco logo ao abrir a Planilha - Removing Blank Rows Automatically


Sim pessoal. sempre perguntam como deletar linhas em branco da planilha, assim que esta for aberta. Segue um código, simples, honesto, rápido e limpinho:

Private Sub Worksheet_Change (ByVal Target As Range)
'Deleta todas as linhas que estiverem em branco que existirem.  
'Previne loops infinitos  Let Application.EnableEvents = False   
'Caso haja mais de uma célula selecionada. 

If Target.Cells.Count > 1 Then
GoTo SelectionCode  
If WorksheetFunction.CountA(Target.EntireRow) = 0 Then 
Target.EntireRow.Delete 
End If  

Let Application.EnableEvents = True  
Exit Sub  

SelectionCode: 
If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then 
Selection.EntireRow.Delete 
End If  

Let Application.EnableEvents = True
End Sub

Tags: VBA, Excel, deletar, apagar, excluir, rows, blank, lines, linha, range, removing, EntireRow, automatically, delete




eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine