VBA Excel - Outros modos para imprimir planilhas selecionadas ou não.

Olá pessoal!

Resolvamos mais esta questão quanto a impressão de planilhas, geralmente contendo Dashboards & Scorecards, ou Cockpits, que precisem ser impressas.

    

Este código imprime as planilhas selecionadas, veja o código do procedimento PrintSelectedsSheets mostrado abaixo.

Sub PrintSelectedSheets (Preview As Boolean)

    Dim N As Long

    Dim M As Long

    Dim Arr() As String

    

    With ActiveWindow.SelectedSheets

        ReDim Arr(1 To .Count)

        For N = 1 To .Count

            Let Arr(N) = .Item(N).Name

        Next N

    End With

    Sheets(Arr).PrintOut Preview:=True

End Sub

Como faço para imprimir apenas as pastas não selecionadas?

Sub PrintUnselectedSheets (Preview As Boolean)

    Dim WS As Object

    Dim N As Long

    Dim Arr() As String

    Dim K As Long

    Dim B As Boolean

    

    ReDim Arr(1 To ActiveWorkbook.Sheets.Count)

    For Each WS In ActiveWorkbook.Sheets

        Let B = True

        With ActiveWindow.SelectedSheets

        For N = 1 To .Count

            Let B = True

            If StrComp(WS.Name, .Item(N).Name, vbTextCompare) = 0 Then

                Let B = False

                Exit For

            End If

        Next N

        If B = True Then

            Let K = K + 1

            Let Arr(K) = WS.Name

        End If

        End With

    Next WS

    If K > 0 Then

        ReDim Preserve Arr(1 To K)

        ActiveWorkbook.Sheets(Arr).PrintOut Preview:=Preview

    End If

End Sub

Como posso fazer para imprimir todas as Sheets, excluindo as que passar como parâmetro?

PrintSheetsExclude false, "Sheet2", "Sheet4", "Sheet6"

This prints all sheets except Sheet2, Sheet4, and Sheet6. The code is shown below:

Sub PrintSheetsExclude (Preview As Boolean, ParamArray Excludes() As Variant)

    Dim Arr() As String

    Dim B As Boolean

    Dim N As Long

    Dim M As Long

    Dim K As Long

    

    ReDim Arr(1 To Sheets.Count)

    For N = 1 To Sheets.Count

        Let B = True

        For M = LBound(Excludes) To UBound(Excludes)

            If StrComp(Sheets(N).Name, Excludes(M), vbTextCompare) = 0 Then

                Let B = False

                Exit For

            End If

        Next M

        If B = True Then

            Let K = K + 1

            Let Arr(K) = Sheets(N).Name

        End If

    Next N

    If K > 0 Then

        ReDim Preserve Arr(1 To K)

        Sheets(Arr).PrintOut Preview:=Preview

    End If

End Sub

Fonte: C Person

Tags: VBA, Office, Excel, print, sheet, imprimir, planilhas

Inspiration: 

       

VBA Excel - Imprimindo múltiplas planilhas simultaneamente

Olá pessoal!

Resolvamos uma questão constante no que diz respeito a impressão de diversas planilhas, geralmente contendo Dashboards, que precisam ser impressos juntos para nos permitir tanto rapidez como praticidade.

Manipulando Impressoras e Impressões: 

• 🖨️ Imprimindo em Impressora Matricial
• 🖨️ Como Automatizar Configurações de Impressão em Relatórios
• 🖨️ Como Listar Todas as Impressoras Instaladas
• 🖨️ Como Listar Tipos de Papel e Bandejas Suportados pela Impressora
• 🖨️ Como Abrir Relatórios Filtrados de Forma Eficiente
• 🖨️ Como Gerenciar Relatórios Sem Dados Usando VBA

Quando imprimimos uma sheet no MS Excel, esta é impressa num trabalho de impressão próprio, mas a impressão de várias sheets criam vários trabalhos de impressão. 

Neste artigo verá descrito um código que pode ser usado para imprimir várias planilhas como um único trabalho de impressão. O primeiro parâmetro para todas as funções é chamado de visualização e indica se as folhas devem ser exibidas na janela de pré-visualização (Preview = True) ou enviadas diretamente para a impressora ativa (Preview = False).

Esta Procedure tem como parâmetros os nomes das planilhas a serem impressas:

    PrintSheets False, "Sheet1", "Sheet3", "Sheet5"

    

Este código imprime as planilhas: Sheet1, Sheet3, e Sheet5, vejoa o código do procedimento PrintSheets mostrado abaixo.

    Sub PrintSheets (Preview As Boolean, ParamArray SheetNames() As Variant

    ' PrintSheets

    ' Todas as sheets que serão impressas são passadas como parametro.

    ' As sheets que não existirem serão ignoradas.

    Dim Arr() As String

    Dim N As Long

    Dim K As Long

    Dim B As Variant

    Dim WS As Object

    If UBound(SheetNames) >= LBound(SheetNames) Then

        ReDim Arr(LBound(SheetNames) To UBound(SheetNames))

        Let K = LBound(SheetNames)

        For N = LBound(SheetNames) To UBound(SheetNames)

            On Error Resume Next

            Err.Clear

            Set WS = Sheets(SheetNames(N))

            If Err.Number = 0 Then

                Let Arr(K) = SheetNames(N)

                Let K = K + 1

            End If

            On Error GoTo 0

        Next N

        If K > 0 Then

            ReDim Preserve Arr(LBound(Arr) To K - 1)

            Sheets(Arr).PrintOut Preview:=Preview

        End If

    End If

End Sub

👉 Não se esqueça de seguir André Bernardes no Linkedin. Clique aqui e me contate via What's App. 

Comente e compartilhe este artigo!

brazilsalesforceeffectiveness@gmail.com

 Série de Livros nut Project 

  

VBA - Retornando Milissegundos.

Hello folks!

Medir o tempo de processamento de certos momentos dentro da nossa aplicação serve para otimizarmos nosso código, processos, acessos, etc.

Talvez deseje medir a performance de suas queries, ou a geração de arquivos em determinando processo de automação. Talvez queira saber qual interface comporta-se melhor no ambiente para o qual está desenvolvendo.

Como fazer isso, como medir, mensurar, detectar?

Fácil, a função abaixo lhe permitirá tal liberdade.

Public Function MilisSeconds() As String

Let 

MilisSeconds

 = Strings.Format(Now, "dd-MMM-yyyy HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)

End Function

Mas como posso aplicar isso nas minhas procedures e functions ? Segue exemplo:

Private Sub btnSave_Click()

    ' Author:                     Date:               Contact:

    ' André Bernardes             10/05/2011 15:31    bernardess@gmail.com     http://inanyplace.blogspot.com/

    ' Application: ********.

    ' Cria a **************************************.

    ' Listening: Recognizer - Daft Punk - Tron Legacy.

    Dim nStart As String

    DoCmd.RunCommand acCmdSaveRecord

    Let nStart = Right(TimeInMS(), 11) 'Right(Now(), 8)

    

    Call AdjustSpecialties

    Call AssemblerCentralEngine

    Call AssemblerCentralEngine2

    Call SeedData                                                    ' Arquiva os dados para consulta e análise posteriores

    Me.cmbCenarios.Requery                                    ' Atualiza o Combo de Exclusão de cenários.

    Let Me.cxVersion.Value = Now() & " Versão 00"   ' Atualiza a caixa de texto onde se dá os nomes para novos cenários.

    MsgBox "Tabela criada com sucesso!" & Chr(10) & Chr(13) & _

           "" & Chr(10) & Chr(13) & _

           " TABELA: tbl_Bernardes" & Chr(10) & Chr(13) & _

           "" & Chr(10) & Chr(13) & _

           "CENÁRIO: " & ReturnVersion() & Chr(10) & Chr(13) & _

           "" & Chr(10) & Chr(13) & _

           "Iniciou em: " & nStart & " - Finalizou em: " & Right(TimeInMS(), 11) & Chr(10) & Chr(13) & _

           "" & Chr(10) & Chr(13) & _

           "Os dados foram preservados para análises posteriores." & Chr(10) & Chr(13) & _

           "", vbInformation, ".: Informação: Versão " & ReturnVersion()

End Sub

Existe um outro modo de ter este mesmo resultado, utilizando API e DLL. Não acredito que seja mais útil, mas em todo caso, teste-o você mesmo se desejar:

Private Type SYSTEMTIME

wYear As Integer

wMonth As Integer

wDayOfWeek As Integer

wDay As Integer

wHour As Integer

wMinute As Integer

wSecond As Integer

wMilliseconds As Integer

End Type

Private Declare Sub GetSystemTime Lib "kernel32" 

(lpSystemTime As SYSTEMTIME)

Public Function nMillisecond() As String

Dim tSystem As SYSTEMTIME

Dim nRet

On Error Resume Next

GetSystemTime tSystem

Let sRet = Hour(Now()) & ":" & Minute(Now()) & ":" & Second(Now()) & _

":" & tSystem.wMilliseconds

Let nMillisecond = nRet

End Function

Vocês sabem como sou, se existe um outra forma, e a conheço, não deixo de lhes mostrar (medindo processamento em centésimos de segundos com o método Timer):

Public Sub TestBernardes()

    Dim fTimeStart As Single

    Dim fTimeEnd As Single

    Let fTimeStart = Timer

    

SomeProcedure

    

Let 

fTimeEnd = Timer

    

Debug.Print Format$((fTimeEnd - fTimeStart) * 100!, "0.00 "" Centésimos de segundos""")

End Sub

Public Sub SomeProcedure()

    Dim i As Long, r As Double

    For i = 0& To 10000000

        Let r = Rnd

    Next

End Sub

Tags: milissegundo, timer, milliseconds

Referências: VBAADUD

                      Excel Forum

                 Stack Overflow

Assuntos similares:

Calculating process time 

Excel VBA Timer

How to Get Time in Milliseconds using Excel VBA

How to add milliseconds to Now()

How to get milliseconds in VBA Now() function

Miliseconds in dim as date

Millisecond timer using VBA

Show current date & system time with milliseconds

Using Milliseconds in VBA

VBA Milliseconds

VBA Now() function

VBA Timer function

André Luiz Bernardes

A&A® - Work smart, not hard.