Сохраняйте изображения с помощью VBA на экране блокировки Windows 10

Question

У меня есть код VBA, который сохраняет диапазон ячеек в формате изображения; однако, если P C имеет заблокированный экран, все сохраненные изображения - белые:

Range("B6:M80").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
GifLargh = Selection.Width
GifAlt = Selection.Height
Sheets("Summary").Select
Dim ch As ChartObject
Set ch = Sheets("Summary").ChartObjects.Add(1, 1, GifLargh, GifAlt)
Sheets("Summary").ChartObjects(1).Activate
Worksheets("Summary").ChartObjects(1).Chart.Select
Worksheets("Summary").ChartObjects(1).Chart.Paste
Worksheets("Summary").ChartObjects(1) _
.Chart.Export Filename:="C:\Macro\Summary.gif", FilterName:="GIF"

тот же код отлично работает, если экран не заблокирован: есть ли у кого-нибудь предложение решить проблема?

Answer 1

1. Не используйте .Select или .Activate или Selection, если только вам это не нужно. Это делает ваш код ненадежным и экстремально медленным.

   Поэтому вместо

   Range("B6:M80").Select
   Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
   

   напишите его без

   Range("B6:M80").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
   

2. Убедитесь, что все ваши * Объекты 1016 *, Cells, Columns и Rows имеют рабочий лист. В противном случае Excel не может точно знать, в каком листе находится диапазон Range("B6:M80").
   Поэтому укажите лист, как показано ниже:

   ThisWorkbook.Worksheets("MySheet").Range("B6:M80")
   

3. Существует разница между Sheets и Worksheets. В то время как Worksheets содержит только рабочие листы, Sheets также содержит листы диаграмм или другие. Так что не используйте их вместе. Если вы имеете в виду рабочий лист, то не используйте для этого Sheet.

4. Объявите все свои переменные правильно перед их использованием. Убедитесь, что вы используете Option Explicit.

---

Так что, если вы очистите его, он будет выглядеть примерно так

Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.Worksheets("your source worksheet") '‹~~ adjust your sheet name

wsSource.Range("B6:M80").CopyPicture Appearance:=xlScreen, Format:=xlBitmap

Dim GifLargh As Double
GifLargh = wsSource.Range("B6:M80").Width

Dim GifAlt As Double
GifAlt = wsSource.Range("B6:M80").Height

Dim wsSum As Worksheet
Set wsSum = ThisWorkbook.Worksheets("Summary")

Dim ch As ChartObject
Set ch = wsSum .ChartObjects.Add(1, 1, GifLargh, GifAlt)

With wsSum.ChartObjects(1)
    .Activate      '‹~~ might not be necessary (check it)
    .Chart.Select  '‹~~ might not be necessary (check it)
    .Chart.Paste
    .Chart.Export Filename:="C:\Macro\Summary.gif", FilterName:="GIF"
End With

Если этот код выдает белые изображения Кроме того, может быть вероятность того, что вы не сможете сделать скриншот с помощью .CopyPicture, если экран заблокирован.

Answer 2

Я решил использовать блокиратор Keboard и Mouse следующим образом: https://sourceforge.net/projects/winkeylock/