Uma necessidade comum na utilizacao de Pivot Tables e que duas ou mais Pivots sejam filtradas com o mesmo criterio, para isso desenvolvi o seguinte codigo:Sub FilterPivots()'Developed by Bruno Leite 'officevb.com Dim pvt As PivotTable, pvt1 As PivotTableApplication.EnableCancelKey = xlDisabledApplication.EnableEvents = FalseApplication.ScreenUpdating = FalseDim pi As PivotItem, pi1 As PivotItemDim pf As PivotField'Set to the name of your PivotTableSet pvt = FullYear.PivotTables("FY")Set pvt1 = FullYear.PivotTables("FY1")Application.EnableEvents = FalseFor Each pf In pvt.PivotFields Select Case pf.Orientation 'Campos de linha Case xlRowField For Each pi In pf.PivotItems pvt1.PivotFields(pf.Name).PivotItems(pi.Name).visible = pi.visible Next pi 'Campos de Pagina Case xlPageField If pf.EnableMultiplePageItems Then pvt1.PivotFields(pf.Name).ClearAllFilters pvt1.PivotFields(pf.Name).EnableMultiplePageItems = pf.EnableMultiplePageItems For Each pi1 In pf.PivotItems pvt1.PivotFields(pf.Name).PivotItems(pi1.Name).visible = pi1.visible Next pi1 Else strFilter = pf.CurrentPage pvt1.PivotFields(pf.Name).ClearAllFilters pvt1.PivotFields(pf.Name).CurrentPage = strFilter End If End SelectNext pfApplication.ScreenUpdating = TrueApplication.EnableEvents = TrueEnd SubPara utiliza-lo coloque no evento change da primeira Pivot da seguinte maneira.Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) FilterPivotsEnd Sub Muitas vezes existe a necessidade de o usuario selecionar alguma pasta (e nao um arquivo) para realizar alguma operacao nas aplicacoes desenvolvidas em VBA.Esta operacao e possivel de ser realizada com o application.GetOpenFileName, porem e necessario um tratamento posterior para que se obtenha somente o diretorio.Esta funcao exibe a seguinte caixa de dialogo, onde e possivel selecionar somente os diretorios e nao os arquivos.Para a utilizar esta opcao utilizaremos o seguinte codigoFunction GetDir(Optional TextToTitle As String = "Select folder...")'http://officevb.com Dim objFld As Object, objShl As Object Set objShl = CreateObject("Shell.Application") Set objFld = objShl.BrowseForFolder(0, TextToTitle, 0) If Not objShl Is Nothing Then GetDir = objFld.self.Path End If Set objShl = Nothing Set objFld = Nothing End FunctionSub TestGetDir()'Testando a rotina GetDir MsgBox "A pasta selecionada foi:" & GetDir("Selecione uma pasta"), vbInformationEnd SubA rotina e em simples, e garante uma aparencia mais profissional ao seu projeto.Em breve mais novidades por aqui!Ate mais... Esta semana me deparei com um problema em uma aplicacao que estou desenvolvendo, ela copia um intervalo de dados do Excel e cola num slide do Powerpoint.O problema ocorria ao utilizar o metodo PasteSpecial em um slide, ao ser chamado a partir do VBA ele colava as informacoes desconfiguradas e com problemas de cores e formatacao.Ao repetir o processo de colagem no proprio Powerpoint tudo funcionava perfeitamente, distribui o codigo para os colegas do trabalho para que testassem em outro ambiente e ele tambem funcionava num ambiente exatamente como o meu com o Windows 7 SP2 e Office 2010 SP1.Depois de muito tentar, pesquisar e nao encontrar uma solucao resolvi verificar o meu codigo eu utilizava a criacao de objetos com o Late Binding com a seguinte sintaxeDim pptA As ObjectFiz referencia a Microsoft Powerpoint 14.0 e a alterei para a seguinte linha, utilizando o Early BindingDim pptA As Powerpoint.ApplicationAo executar o teste o resultado obtido foi o esperado com a colagem realizada corretamente.Em minhas pesquisas para a resolucao, verifiquei o Event Viewer do Windows (pois as vezes a aplicacao entrava em crash interminentemente) o problema ocorria sempre na mesma DLL ppcore.dll, ao realizar uma busca na maquina por esta DLL obtive o seguinte resultado. Ou seja haviam 3 versoes desta DLL na maquina,