Macro de Impressão

Question

Preciso de uma macro que faça a solicitação do numero da pagina (Exemplo: Imprimir somente Página Pagina 2 ou 1 e 2) que preciso imprimir integrada com essa macro que utilizo com seleção de impressora. 

Sub Imprimir_Selecao_Impressora()
    'Macro com seleção de impressão
    
    If Application.Dialogs(xlDialogPrinterSetup).Show Then
        
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        
        MsgBox "Impressão Realizada com Sucesso!", vbInformation, "Impressora"
        
    End If
End Sub

Answer 1

BárbaraBettanin,

   Pode ser uma janela de diálogo?

Sub print_tudo()
    Application.Dialogs(xlDialogPrint).Show
End Sub

=======================================
Criando um botão que imprime no Excel

https://www.aprenderexcel.com.br/2017/vba/criando-um-botao-que-imprime-no-excel
=======================================

    Ou imprimir uma faixa específica:

Sub Intervalo_Específico()
    Range("A5:E18").PrintOut
End Sub

[]'s,
Fabio I.

Answer 2

Oi Amigo!

Precisaria que essa macro fizesse a somente a impressão do seguinte range: B2:M24 e não da area select.. consegue incluir nessa macro somente determinado range?

Sub Imprimir_Selecao_Impressora_Pagina1()
    'Macro com seleção de impressão
    
    If Application.Dialogs(xlDialogPrinterSetup).Show Then
        
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        
        MsgBox "Impressão Realizada com Sucesso!", vbInformation, "Impressora"
        
    End If
End Sub

Answer 3

Answer 4

BárbaraBettanin,

    Talvez se definir a área de impressão no braço:

==================================================

VBA Printing ranges from different sheets and prompting the user only once

Sheets("Sheet1").Select
ActiveSheet.PageSetup.PrintArea = "$B$2:$M$24"
ActiveWindow.SelectedSheets.PrintOut

https://stackoverflow.com/questions/26303481/vba-printing-ranges-from-different-sheets-and-prompting-the-user-only-once

==================================================
Examples to print worksheets

https://www.rondebruin.nl/win/s9/win010.htm
==================================================
Método Sheets.PrintOut (Excel)

https://msdn.microsoft.com/pt-br/vba/excel-vba/articles/sheets-printout-method-excel?f=255&MSPPError=-2147217396
==================================================
Print Worksheets VBA
Print A Range

http://www.excelhowto.com/macros/print-worksheets-vba/
==================================================

[]'s,
Fabio I.

Answer 5

Está dando erro... "Subescrito fora do intervalo" você consegue me enviar a macro ajustada ja?

Answer 6

BárbaraBettanin,

   Acho que eu viajei, não tem a opção "RANGE" ... você pode tentar definir o intervalo de impressão antes de imprimir?

ActiveSheet.PageSetup.PrintArea = "$B$2:$M$24"

[]'s,
Fabio.

Answer 7

Perfeito! Funcionou!

Ficou assim

Sub Imprimir_Pagina1()
    'Macro com seleção de impressão
    
    If Application.Dialogs(xlDialogPrinterSetup).Show Then
        ActiveSheet.PageSetup.PrintArea = "E2:P26" 'Define o range a ser impresso
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        
        MsgBox "Impresso com Sucesso Página 1 Tanga.", vbInformation, "Impressora"
        
    End If
End Sub

Answer 8

Muitíssimo obrigada!

Answer 9

Será que você consegue me ajudar com essa macro que está deixando minha planilha lenta?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then
        Exit Sub
    End If
    On Error GoTo ErrHandler:
       'Letra Primeira Maiuscula
    If Not Application.Intersect(Application.Union(Range("m4:m2002"), Range("l4:l2002"), Range("n4:n2002"), Range("u4:u2002")), Target) Is Nothing Then
        
        If Not IsNumeric(Target.Value) Then
            Application.EnableEvents = False
            Target.Value = TitleCase(Target.text)
            Application.EnableEvents = True
        End If
          
    End If
    
     Application.EnableEvents = True
     
     'Letras Maiusculas
     If Target.Column = 6 Or Target.Column = 7 Or Target.Column = 11 Or Target.Column = 15 Then
            If Not (Target.text = UCase(Target.text)) Then
               Target = UCase(Target.text)
        End If
    End If
    
ErrHandler:
    Application.EnableEvents = True
   
End Sub

Function TitleCase(text As String) As String
    Dim doc As Object
    Dim sentence, word, w
    Dim i As Long, j As Integer
    Dim arrLowerCaseWords
    
    arrLowerCaseWords = Array("a", "as", "ao", "do", "da", "das", "de", "do", "dos", "para", "em", "na", "nas", "no", "à", "o", "e", "é", _
                              "ou", "com", "sem", "desde", "até", "pelo", "por", "não", "como", "um", "uma", "uns", "são", "mas")
    
    text = Application.WorksheetFunction.Proper(text)
    
    Set doc = CreateObject("Word.Document")
    
    doc.Range.text = text
    
    For Each sentence In doc.Sentences
        For i = 2 To sentence.Words.Count
            If sentence.Words.Item(i - 1) <> """" Then
                Set w = sentence.Words.Item(i)
                For Each word In arrLowerCaseWords
                    If LCase(Trim(w)) = word Then
                        w.text = LCase(w.text)
                    End If
                    
                    j = InStr(w.text, "'")
                    
                    If j Then w.text = Left(w.text, j) & LCase(Right(w.text, Len(w.text) - j))
                    
                Next
            End If
        Next
    Next
    
    TitleCase = doc.Range.text
    
    doc.Close False
    Set doc = Nothing
End Function

Answer 10

BárbaraBettanin,

   Obrigado pela resposta.
   Eu vi seu outro post sobre esse assunto...
   ... acredito que o que pode deixar lento são os FOR, existe 3 aninhados! mas como mudar isso?

[]'s,
Fabio I.