Saberexcel - o site das macros

Essa macro do Aplicativo Microsot Excel VBA(Visual Basic Application), imprime o Userform da tela ativa no Aplicativo Word e também envia para impressora para impressão.


Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)

Private Sub CommandButton2_Click()
Dim Wrd As Object, WrdDoc As Object, Resposta As String

Resposta = MsgBox("Deseja imprimir o userform ativo no Word e Impressora?", _
vbYesNo + vbInformation, "Saberexcel - o site das macros ")
If Resposta = 6 Then '6 = sim

'Captura a tela na forma ativa
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents

Set Wrd = CreateObject("Word.Application") 'criando uma sessão no Word
Wrd.Visible = True 'condição pendenete para acionar ou nao o word

On Error Resume Next
Set WrdDoc = Wrd.Documents.Add
WrdDoc.PageSetup.Orientation = wdOrientLandscape

Wrd.Selection.PasteSpecial 'colando o documento dentro do word

With WrdDoc.Shapes(1) 'redimensionamento e posicionamento do objeto a ser impresso
.Left = 40 'Borda à Esquerda
.Top = 40 'Borda ao topo(Alto)
.Width = 400
End With

WrdDoc.PrintOut 'Impressão,

'WrdDoc.Close False 'fecha o word sen salvar
'WrdDoc.Quit 'fecha o Aplicativo Word

Else

Exit Sub
End If

MsgBox ("Userform, imprimido com sucesso no Word e Impressora!!!"), vbInformation, "Saberexcel - site das macros"
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub


Aprenda sobre o Aplicativo Microsot Excel VBA(Visual Basic Application), com Saberexcel o site das macros

Saberexcel - o site das macros

Esta macro do aplicativo Microsoft Excel VBA, imprime e salva determinado documento com o valor desejado
da célula (E4). Resultado do nome arquivo salvo...: veja no exemplo: " Salva como:" (Meus Documentos 21-ago-2010-19 30 48)

Sub Imprime_Arquivo()
vCelula = Range("E4") ' na célula(E4) voce atribui (=Agora() )
Range("12:12").Select

Selection.RowHeight = 0
ThisWorkbook.SaveAs "C:\Meus documentos\" & vCelula & ".xls"
ActiveWindow.SelectedSheets.PrintOut Copies:=3, Collate:=True

MsgBox "A sua folha imprimida foi enviada, por favor, busque-a na impressora padrão", vbInformation
Application.OnTime Now() + TimeValue("00:00:01"), "AutoClose"

End Sub

Sub Encaminhando_Planilha()
On Error GoTo SaberErro

Planilha_Numero = InputBox("Entre com numero da planilha , Entre 0 se voce estiver iniciando", "TOTAL PLANILHAS CERTAS HOJE", Range("F2"))

Select Case Planilha_Numero
Case Else
Range("F2") = Planilha_Numero + 1
End Select
Exit Sub

SaberErro:
MsgBox "Entre com o número da Planilha válido!!", , "ERROR - SABEREXCEL"
Call Encaminhando_Planilha
End Sub


Sub AutoClose()
ThisWorkbook.Close SaveChanges:=False
End Sub

Aprenda Microsoft Excel VBA --((SaberExcel))--

Saberexcel - o site das macros

Imprimir área de um range dinâmico

Macro do Aplicativo Microsoft Excel VBA, imprime uma determinada área de um range dinâmico, que expande tamanho com a digitação:
Inserindo um range dinâmico para impressão de uma determinada área que expande com a digitação

você vai conseguir isso através de um range dinâmico:
nomear o range como "impressao" ou outro nome qualquer

=DESLOC(Extrair!$B$3;0;0;CONT.VALORES(Extrair!$B:$B);6)

Sub Imprimir_Range_Dinamico
Range("Impressao").PrintOut Copies:=1
End Sub

determinar área a ser imprimida
esta área vai da coluna B (Range(b3) mais seis colunas a frente
dos dados digitados.

Para inserir um range dinâmico abra a caixa de diálogo Definir Nome :
1) em sheet1 selecione os dados na coluna b (b6:bn)
2)<Inserir <Nome <Definir

Nome..............: impressao
Refere-se à.......: =DESLOC(Extrair!$B$3;0;0;CONT.VALORES(Extrair!$B:$B);6)


Aprenda Microsoft Excel VBA --((SaberExcel))--

Saberexcel - o Site das Macros
Criar um botão para impressão personalizado que chama uma determinada macro na barra de ferramentas

Macros do Aplicativo Microsoft Excel VBA, insere um botão personalizada na barra de ferramenta da planilha'
que chama uma outra macro configurada para impressão de acordo com o tamanho do texto, paisagem ou retrato.
mas veja bem Lúcia, no teu caso, aqui seria bom lançar uma macro que selecione a área corrente, para que seja
selecionado automaticamente, através de um range dinâmico, que funciona bem.

Sub Definir_botoes_personalizados()
Dim MeuBotao As CommandBarButton
Set MeuBotao = CommandBars("standard").Controls.Add(msoControlButton)

With MeuBotao
.Caption = "Impressao_Saberexcel"
.Style = msoButtonIconAndCaption
.FaceId = 4 'definir o icone impressora
.TooltipText = "Imprimir a seleçao SaberExcel" 'descrição da função
.OnAction = "Imprimir_Selecao" 'macro a executar
End With

End Sub


Essa macro será chamada pelo botão personalizado acima que será inserido na Barra de Ferramenta da planilha.
Sub Imprimir_Selecao()

With ActiveSheet.PageSetup
.PrintArea = Selection.Address 'define a zona de impressao
If Selection.Height > Selection.Width Then 'determina a orientação
.Orientation = xlPortrait
Else
.Orientation = xlLandscape
End If

.CenterHorizontally = True
.CenterVertically = True

End With
With ActiveSheet

.PrintOut 'chama a impressão
.PageSetup.PrintArea = False ' zona de impressão
.DisplayPageBreaks = False 'status da pagina

End With
End Sub

Apprenda Microsoft Excel VBA --(-(SaberExcel )-)---

Essas macros do Aplicativo Microsoft Excel VBA, com auxílio de uma caixa de combinação (Combobox) imprimem determinadas áreas da planilha, observem que usei a Instrução Select Case para 'chamar' (referenciar) aos macros específicos. Você poderá baixar o exemplo de planilha no final da página.

Sub Imprimir_determinadas_areas()
Dim MAreas As Variant

MAreas = Sheets("Imprimir").Range("H1")
If Not IsNumeric(MAreas) Then
Exit Sub
Else
Select Case MAreas
Case 1
Call Imprimir_Area_I
Case 2
Call Imprimir_Area_II
Case 3
Call Imprimir_Area_III
Case 4
Call Imprimir_Area_IV
Case 5
Call Imprimir_Area_V
Case 6
Call Imprimir_Area_VI
Case 7
Call Abrir_cxa_dialogo
End Select
End If
End Sub

Sub Imprimir_Area_I()
On Error Resume Next ' no caso de cancelamento da macro
Sheets("Imprimir").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$A$20"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

Sub Imprimir_Area_II()
On Error Resume Next ' no caso de cancelamento da macro
Sheets("Imprimir").Select
ActiveSheet.PageSetup.PrintArea = "$B$1:$B$20"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

Sub Imprimir_Area_III()
On Error Resume Next ' no caso de cancelamento da macro
Sheets("Imprimir").Select
ActiveSheet.PageSetup.PrintArea = "$C$1:$C$20"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

Sub Imprimir_Area_IV()
On Error Resume Next ' no caso de cancelamento da macro
Sheets("Imprimir").Select
ActiveSheet.PageSetup.PrintArea = "$D$1:$D$20"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

Sub Imprimir_Area_V()
On Error Resume Next ' no caso de cancelamento da macro
Sheets("Imprimir").Select
ActiveSheet.PageSetup.PrintArea = "$E$1:$E$20"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

Sub Imprimir_Area_VI()
On Error Resume Next ' no caso de cancelamento da macro
Sheets("Imprimir").Select
ActiveSheet.PageSetup.PrintArea = "$F$1:$F$20"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

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




Aprenda tudo sobre o Aplicativo Microsoft Excel VBA com SaberExcel