Página 1 de 1

Contagem de impressão

Enviado: 22 Jul 2016 às 07:27
por FelipeBarbosa
Bom dia Galera.

Estou com a seguinte dificuldade, tenho uma planilha que tem que ser impressa todos os dias pelos funcionarios com Ordens de serviço, porém o funcionário digita o numero de uma Ordem e muda todo o conteúdo, ai ele imprime. O problema é que tem pessoas imprimindo mais de uma vez o arquivo, queria uma macro para analizar se o arquivo já foi impresso, e através de MsgBox dizer, essa ordem ja foi impressa "X" vezes, tem certeza que deseja imprimir de novo? E podia também aparecer um indicar na planilha que esse numero já foi impresso.

Agradeço a atenção.

Contagem de impressão

Enviado: 25 Jul 2016 às 07:47
por FelipeBarbosa
Já consegui resolver, caso alguém precise segue abaixo Macro para contagem de impressão:


Sub Botão5_Clique()

Range("AR1").Select
Selection.Copy
Sheets("REL - OS").Select
Range("BB1").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=-54


If Sheets("REL - OS").Range("AS1").Value <> 1 Then
MsgBox "Seu arquivo está sendo impresso, aguarde!", vbInformation
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False

Else
Dim Resultado As VbMsgBoxResult
Resultado = MsgBox("Essa Ordem de Serviço já foi impressa, tem certeza que deseja imprimi-la novamente?", vbYesNo, "Imprissão de ordem duplicada")
End If
If Resultado = vbYes Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False

End If

If Resultado = vbNo Then
ActiveCell.FormulaR1C1 = ""
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveWindow.SmallScroll Down:=-54
Else

'cancela

End If

ActiveWindow.View = xlPageBreakPreview
ActiveWindow.View = xlNormalView
ActiveWindow.View = xlPageLayoutView
ActiveWindow.SmallScroll Down:=-54
End Sub