Имеется большой лист, на котором много чего написано и нарисовано. Мне нужна миниатюрная карта этого большого диапазона - в левом верхнем углу.
В принципе это можно сделать через автоснимок. Но он так замедляет работу, что аж жуть. Как сделать скриншот заданной области (записан в ячейке AL3) невысокого качества и разместить картинку этого скриншота на листе - растянув в другом указанном диапазоне (записан в ячейке AL5) ?
Добрый день.
Имеется большой лист, на котором много чего написано и нарисовано. Мне нужна миниатюрная карта этого большого диапазона - в левом верхнем углу.
В принципе это можно сделать через автоснимок. Но он так замедляет работу, что аж жуть. Как сделать скриншот заданной области (записан в ячейке AL3) невысокого качества и разместить картинку этого скриншота на листе - растянув в другом указанном диапазоне (записан в ячейке AL5) ?Snegovik
doober, вы мне скинули МОЙ же файл - и мне объясняете как он работает. Я и так знаю как он работает - потому что сам его и создавал.
Пишу еще раз свой вопрос из первой темы:
Имеется большой лист, на котором много чего написано и нарисовано. Как сделать СКРИНШОТ заданной области (записан в ячейке AL3) невысокого качества и разместить картинку этого скриншота на листе - растянув в другом указанном диапазоне (записан в ячейке AL5) ? (не автоснимок, который уже есть - а СКРИНШОТ)
doober, вы мне скинули МОЙ же файл - и мне объясняете как он работает. Я и так знаю как он работает - потому что сам его и создавал.
Пишу еще раз свой вопрос из первой темы:
Имеется большой лист, на котором много чего написано и нарисовано. Как сделать СКРИНШОТ заданной области (записан в ячейке AL3) невысокого качества и разместить картинку этого скриншота на листе - растянув в другом указанном диапазоне (записан в ячейке AL5) ? (не автоснимок, который уже есть - а СКРИНШОТ)Snegovik
Сообщение отредактировал Snegovik - Суббота, 28.04.2018, 12:08
Sub ertert() Dim PicPth$ PicPth = ThisWorkbook.Path & "\tmpPic.gif"
With Sheets("Лист3") With .Range(.Range("AL3").Value) .CopyPicture With .Parent.ChartObjects.Add(40, 60, .Width / 10, .Height / 10).Chart '.Width / 10, .Height / 10 - чем меньше размер, тем проще/быстрее .Paste .Export PicPth, "GIF" .Parent.Delete End With End With With .Range(.Range("AL5").Value) .Parent.Shapes.AddPicture PicPth, False, True, .Left, .Top, .Width, .Height End With End With
End Sub
[/vba]
Snegovik, привет может, как-то так? [vba]
Код
Sub ertert() Dim PicPth$ PicPth = ThisWorkbook.Path & "\tmpPic.gif"
With Sheets("Лист3") With .Range(.Range("AL3").Value) .CopyPicture With .Parent.ChartObjects.Add(40, 60, .Width / 10, .Height / 10).Chart '.Width / 10, .Height / 10 - чем меньше размер, тем проще/быстрее .Paste .Export PicPth, "GIF" .Parent.Delete End With End With With .Range(.Range("AL5").Value) .Parent.Shapes.AddPicture PicPth, False, True, .Left, .Top, .Width, .Height End With End With