-
Posts
1 -
Cadastrado em
-
Última visita
Reputação
0-
Bernardojgv começou a seguir Print em macro vbs
-
Tenho esta macro feita: #If VBA7 Then Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hwnd As LongPtr) As Long Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #Else Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long Declare Function EmptyClipboard Lib "user32.dll" () As Long Declare Function CloseClipboard Lib "user32.dll" () As Long Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Sub Retângulo1_Click() livro = ActiveWorkbook.Name localBD = ActiveWorkbook.Path & "\" Application.ScreenUpdating = False Set Procura = Workbooks(livro).Worksheets(1).Columns("A").Find(what:="") lin = Procura.Row For i = 2 To lin - 1 MAT = Cells(i, 2).Value If Not IsObject(Applic) Then Set SapGuiAuto = GetObject("SAPGUI") Set Applic = SapGuiAuto.GetScriptingEngine End If If Not IsObject(Connection) Then Set Connection = Applic.Children(0) End If If Not IsObject(session) Then Set session = Connection.Children(0) End If If IsObject(WScript) Then WScript.ConnectObject session, "on" WScript.ConnectObject Applic, "on" End If session.findById("wnd[0]").maximize session.findById("wnd[0]/tbar[0]/okcd").Text = "as03" session.findById("wnd[0]").sendVKey 0 session.findById("wnd[0]/usr/ctxtANLA-ANLN1").Text = MAT session.findById("wnd[0]/usr/ctxtANLA-ANLN2").Text = "0" session.findById("wnd[0]/usr/ctxtANLA-BUKRS").Text = "0671" session.findById("wnd[0]/usr/ctxtANLA-BUKRS").SetFocus session.findById("wnd[0]/usr/ctxtANLA-BUKRS").caretPosition = 4 session.findById("wnd[0]").sendVKey 0 ' Tirar print TirarPrint localBD & MAT & ".png" session.findById("wnd[0]").sendVKey 12 session.findById("wnd[0]").sendVKey 12 Next i Application.ScreenUpdating = True End Sub Sub TirarPrint(filePath As String) ' Simula a combinação de teclas "Alt + PrtSc" Application.SendKeys "^%{PRTSC}" ' Aguarda 1 segundo para garantir que a captura de tela seja processada Sleep 1000 ' Salva a captura de tela no arquivo especificado SalvarClipboardComoArquivo filePath End Sub Sub SalvarClipboardComoArquivo(filePath As String) ' Abrir a área de transferência OpenClipboard 0& ' Verificar se a área de transferência contém uma imagem If IsClipboardFormatAvailable(2) Then ' Obter o identificador do bitmap Dim hBitmap As Long hBitmap = GetClipboardData(2) ' Criar um objeto Picture a partir do identificador do bitmap Dim bmp As Object Set bmp = CreateObject("WIA.ImageFile") bmp.LoadFile "clipboard:" ' Carregar a imagem da área de transferência ' Salvar o objeto Picture como um arquivo bmp.SaveFile filePath End If ' Fechar a área de transferência CloseClipboard End Sub no entanto não está a tirar o print nos passos que coloquei a negrito, como posso resolver?
Sobre o Clube do Hardware
No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais
Direitos autorais
Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais