Снимок экрана Excel Найти и заменить результаты вместе с часами - PullRequest
Новая
       5

Снимок экрана Excel Найти и заменить результаты вместе с часами

0 голосов
/ 27 февраля 2019

Я использую sendkeys для управления опциями в Find и Replace.Однако, когда дело доходит до снятия скриншотов, он делает снимок экрана без результатов.Большинство моих поисков (99%) не дают результатов.Мне просто нужно сделать скриншот всего активного экрана (я использую двойной монитор) и сохранить файл в формате jpg или pdf.

Код, который у меня пока есть, 

Sub Seachpdfer()
 Dim searchquery As Range
 Dim mystring As String
 Dim mypic As Shape

 Set searchquery = Worksheets("Query").Range("AA2:AA10001")

 For Each cell In searchquery

    mystring = cell.Value

    If cell.Value = "" Then
        Exit For
    End If

  Worksheets("Restricted List").Select
  Worksheets("Restricted List").Range("A1").Activate
  Worksheets("Restricted List").Range("I1").Activate

  Application.CommandBars("Edit").Controls("Find...").Execute



  Application.SendKeys ("%n" & mystring)
  Application.SendKeys ("{TAB}{TAB}")
  Application.SendKeys ("Sheet")
  Application.SendKeys ("{ENTER}")
  'Application.SendKeys ("{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}")
  Application.SendKeys ("{TAB}{TAB}")
  Application.SendKeys "%i", True  ' This clicks the Find button on the Find and Replace dialog

' This is where it all breaks. I tried using doevents and tried using application wait. But the screenshot I get does not show
'The search result We could not find what....."

  Application.SendKeys "({1068})", True
  DoEvents
  ThisWorkbook.Worksheets("Staging").Activate
  ActiveSheet.Paste
  sFileName = ThisWorkbook.Path & "\" & mystring & ".jpg"

  For Each mypic In ActiveSheet.Shapes

        mypic.Select

       Call PictureExport ' This function converts it to a chart and prints out the pdf


   Next

 Next
End Sub

Любая помощь будет высоко ценится.Спасибо.

...