Скриншот выделенной области таблицы в Excel 2010

@timsc1 · Регистрация: 27.11.2011

Студворк — интернет-сервис помощи студентам

Здравствуйте! Такая проблема:
Нужно сделать два скриншота (это две кнопки):
один - выделенной области таблицы
другой - всего экрана
Картинки помещаются в файлы на диск. У кого-нибудь есть коды, как сделать??? Спасибо!!!

Скрипт · 17.12.2012, 21:16

timsc1, вот обсуждалось недавно:
Не работает макрос в Windows 64

toiai · 17.12.2012, 21:41

timsc1, тогда попробуйте так:

Visual Basic
1
2
Private Declare PtrSafe Function keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) As Boolean

@timsc1 · 17.12.2012, 21:43 **[ТС]**

завтра попробую на работе. там 32-я. За всё Вам спасибо!!!

@KoGG · 26.12.2012, 11:21

CaptureRangePicture копирует выделенный диапазон и в буфер обмена и в файл.
Имя и путь файла определяются в конце этой процедуры в строке Clip2File "C:\TEMP\range_Captured.bmp"
Проект должен быть подключен к библиотеке типов "OLE Automation".
Проект тестировался в Офисе 2007 и Windows 7.

@KoGG · 26.12.2012, 11:27

Для копирования в буфер всего экрана или только окна Excel Module1 надо дополнить одной декларацией и двумя процедурами.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Declare Function GetActiveWindow Lib "user32" () As Long  ' Вставить до первой процедуры
 
Sub CaptureActiveWindow()
    On Error GoTo ErrorCaptureActiveWindow
    Dim dhWND As Long, sp As RECT, x As Long
    dhWND = GetActiveWindow()
    If dhWND <> 0 Then
        x = GetWindowRect(dhWND, sp)
        ScrnCap sp.Left, sp.Top, sp.Right, sp.Bottom
        Clip2File "C:\TEMP\ActiveWindow.bmp"
    End If
    Exit Sub
ErrorCaptureActiveWindow:
    MsgBox Err & ":Error in CaptureActiveWindow. Error Message: " & Err.Description, vbCritical, "Warning"
    Exit Sub
End Sub
 
Public Sub CaptureDesktop()
    On Error GoTo ErrorCaptureDesktop
    Dim dhWND As Long, sp As RECT, x As Long
    dhWND = GetDesktopWindow
    If dhWND <> 0 Then
        x = GetWindowRect(dhWND, sp)
        ScrnCap sp.Left, sp.Top, sp.Right, sp.Bottom
        Clip2File "C:\TEMP\Desktop.bmp"
    End If
    Exit Sub
ErrorCaptureDesktop:
    MsgBox Err & ":Error in CaptureDesktop. Error Message: " & Err.Description, vbCritical, "Warning"
    Exit Sub
End Sub

toiai · 26.12.2012, 18:44

Вот пример для 32Bit и ОФИС 2010:

18.03.2013, 22:30

Доброго времени суток, подскажите пожалуйста как сделать чтобы макрос скриншоп в файл включался по условию (приведено ниже) и автоматически присваивалось другое имя, при этом чтобы звук продолжал пиликать
т.е. в тот момент когда возникает условие K32<M32 или K70<M70 пиликает звук и сохраняются скриншопы с именем 0001, 0002, 0003.....

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszName As String, ByVal dwFlags As Long) As Long
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Dim расчетное время As Date

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("K32") < Range("M32") Then
Call sndPlaySound("C:\Windows\Media\1.wav", 1)
End If

If Range("K70") < Range("M70") Then
Call sndPlaySound("C:\Windows\Media\2.wav", 1)
End If

End Sub

dev.Free · 19.03.2013, 11:17

Visual Basic
1
2
If 64Bit
#End If

писать надо!

19.03.2013, 16:30

If 64Bit
#End If
что это значит? не будет работать на 64 разрядной винде?

dev.Free · 19.03.2013, 16:41

код есть специально для 64 битных систем. найду ссылки скину

Новые блоги и статьи Все статьи Все блоги /
Nekobox - outbounds[0].transport: unknown transport type: raw damix 01.10.2026 Фикс ошибки Правым кликом по серверу -> отладочная информация -> edit Заменить "net": "raw", на "net": "tcp", Нажать кнопку reload.	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .
Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .	Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .	Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .

@timsc1 15 / 15 / 2 Регистрация: 27.11.2011 Сообщений: 714

	Скриншот выделенной области таблицы в Excel 2010 14.12.2012, 15:47. Показов 15226. Ответов 29 Метки нет (Все метки) Здравствуйте! Такая проблема: Нужно сделать два скриншота (это две кнопки): один - выделенной области таблицы другой - всего экрана Картинки помещаются в файлы на диск. У кого-нибудь есть коды, как сделать??? Спасибо!!! 0

Скрипт 5472 / 1150 / 50 Регистрация: 15.09.2012 Сообщений: 3,578
	17.12.2012, 21:16
	timsc1, вот обсуждалось недавно: Не работает макрос в Windows 64 0

@timsc1 15 / 15 / 2 Регистрация: 27.11.2011 Сообщений: 714
	17.12.2012, 21:43 [ТС]
	завтра попробую на работе. там 32-я. За всё Вам спасибо!!! 0

g-a-s
	18.03.2013, 22:30
	Доброго времени суток, подскажите пожалуйста как сделать чтобы макрос скриншоп в файл включался по условию (приведено ниже) и автоматически присваивалось другое имя, при этом чтобы звук продолжал пиликать т.е. в тот момент когда возникает условие K32<M32 или K70<M70 пиликает звук и сохраняются скриншопы с именем 0001, 0002, 0003..... Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszName As String, ByVal dwFlags As Long) As Long Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long Dim расчетное время As Date Private Sub Worksheet_Change(ByVal Target As Range) If Range("K32") < Range("M32") Then Call sndPlaySound("C:\Windows\Media\1.wav", 1) End If If Range("K70") < Range("M70") Then Call sndPlaySound("C:\Windows\Media\2.wav", 1) End If End Sub

g-a-s
	19.03.2013, 16:30
	If 64Bit #End If что это значит? не будет работать на 64 разрядной винде?

dev.Free Заблокирован
	19.03.2013, 16:41
	код есть специально для 64 битных систем. найду ссылки скину 1