Sub Макрос1() Set sh = Selection.ShapeRange.Item(1) With sh .LockAspectRatio = msoFalse 'Отрезаем лишние части With .PictureFormat .CropLeft = 30 .CropTop = 40 .CropBottom = 20 .CropRight = 50 End With ' Изменаем размеры если надо .Height = 280 .Width = 595 'Перемещаем в ячейку N1 .Top = [n1].Top .Left = [n1].Left End With End Sub
[/vba]
Можно макросом: [vba]
Код
Sub Макрос1() Set sh = Selection.ShapeRange.Item(1) With sh .LockAspectRatio = msoFalse 'Отрезаем лишние части With .PictureFormat .CropLeft = 30 .CropTop = 40 .CropBottom = 20 .CropRight = 50 End With ' Изменаем размеры если надо .Height = 280 .Width = 595 'Перемещаем в ячейку N1 .Top = [n1].Top .Left = [n1].Left End With End Sub
Используйте фигуру (то есть так, как у Вас сейчас). Сделайте скриншот. Затем кликните правой кнопкой мыши по любой границе фигуры - Формат фигуры - появится окно - Заливка - Рисунок или текстура - Буфер обмена - в фигуру будет вставлен скриншот. П.С. после вставки рисунка в контекстном меню пункт "Формат фигуры" заменяется на "Формат рисунка", но все работает, как надо.
Используйте фигуру (то есть так, как у Вас сейчас). Сделайте скриншот. Затем кликните правой кнопкой мыши по любой границе фигуры - Формат фигуры - появится окно - Заливка - Рисунок или текстура - Буфер обмена - в фигуру будет вставлен скриншот. П.С. после вставки рисунка в контекстном меню пункт "Формат фигуры" заменяется на "Формат рисунка", но все работает, как надо.Karataev
Сообщение отредактировал Karataev - Воскресенье, 10.01.2016, 12:13
Ночью нашел такое решение. (Я извиняюсь если не правильно вставил изображение, с нарушениями правил)
Всем спасибо за отклик, возможно есть еще идеи - пишите. Рассмотрим все сейчас.
Весь смысл сократить и сэкономить время обработки данных вводимые в ручную. Снять скрин с терминала, дать имя, записать в файл, изменить открыть,вставить - Долго. А снять с экрана в буфер обмена, и сразу на лист - быстро, но он здоровый. И уходит время на подгонку размера. Два раза в день на 100 парах такое придется делать, а это время.
[p.s.]Вопрос к SLAVICK посоветуйте пожалуйста с чего начать разбор макросов для "чайников"
p.p.s. вопрос к модераторам. Если по данной книге есть другие проблемы - мне создавать отдельную тему с другим вопросом?[/p.s.] [moder]К ppsу - да, совершенно верно. На каждый вопрос должна быть своя тема.
ЦитатаNic70y,
т.е. Вы не этим пользуетесь?
Ночью нашел такое решение. (Я извиняюсь если не правильно вставил изображение, с нарушениями правил)
Всем спасибо за отклик, возможно есть еще идеи - пишите. Рассмотрим все сейчас.
Весь смысл сократить и сэкономить время обработки данных вводимые в ручную. Снять скрин с терминала, дать имя, записать в файл, изменить открыть,вставить - Долго. А снять с экрана в буфер обмена, и сразу на лист - быстро, но он здоровый. И уходит время на подгонку размера. Два раза в день на 100 парах такое придется делать, а это время.
[p.s.]Вопрос к SLAVICK посоветуйте пожалуйста с чего начать разбор макросов для "чайников"
p.p.s. вопрос к модераторам. Если по данной книге есть другие проблемы - мне создавать отдельную тему с другим вопросом?[/p.s.] [moder]К ppsу - да, совершенно верно. На каждый вопрос должна быть своя тема.to_ha
Сообщение отредактировал _Boroda_ - Воскресенье, 10.01.2016, 14:15
А вот так если? Жмете у себя Альт+ПринтСкрин, переходите в мой файл Excel, топаете на рисунок, жмете Делит (если там уже есть другой рисунок), жмете Контрл+v или Шифт+Инсерт Хитрость в том, что на листе не фигура, а диаграмма и Вы в нее вставляете скопированный скрин.
А вот так если? Жмете у себя Альт+ПринтСкрин, переходите в мой файл Excel, топаете на рисунок, жмете Делит (если там уже есть другой рисунок), жмете Контрл+v или Шифт+Инсерт Хитрость в том, что на листе не фигура, а диаграмма и Вы в нее вставляете скопированный скрин._Boroda_
это не фигура и не диаграмма, а скрин с терминала МТ4
Давайте еще раз - свой скрин Вы делаете как обычно, хоть с терминала, хоть еще откуда, а вот когда вставляете в файл Excel, то там на листе уже заранее вставлена пустая диаграмма с настроенными размерами (как у меня в файле; диаграммы нужно вставить на каждый лист только один раз при подготовке файла, потом они так там и останутся). Вы топаете мышой в нее, если там уже есть какое-то изображение, то жмете Делит (если там просто пустая рамка, то просто топаете, без Делита) и жмете Контрл+v. Ваш скрин вставится, но его размеры уменьшатся до размеров диаграммы, которые Вы уже заранее сделали такими, как Вам нужно.
это не фигура и не диаграмма, а скрин с терминала МТ4
Давайте еще раз - свой скрин Вы делаете как обычно, хоть с терминала, хоть еще откуда, а вот когда вставляете в файл Excel, то там на листе уже заранее вставлена пустая диаграмма с настроенными размерами (как у меня в файле; диаграммы нужно вставить на каждый лист только один раз при подготовке файла, потом они так там и останутся). Вы топаете мышой в нее, если там уже есть какое-то изображение, то жмете Делит (если там просто пустая рамка, то просто топаете, без Делита) и жмете Контрл+v. Ваш скрин вставится, но его размеры уменьшатся до размеров диаграммы, которые Вы уже заранее сделали такими, как Вам нужно._Boroda_
D: - это не диапазон - а "испорченный" смайлик (такое бывает если удалить пробел до или после смайла)
Альт+ПринтСкрин - копирует активное окно, но если у окна есть ненужные поля - их можно автоматически обрезать макросом при помощи .Crop. На сколько я понял это и нужно было сначала.
D: - это не диапазон - а "испорченный" смайлик (такое бывает если удалить пробел до или после смайла)
Альт+ПринтСкрин - копирует активное окно, но если у окна есть ненужные поля - их можно автоматически обрезать макросом при помощи .Crop. На сколько я понял это и нужно было сначала.
Книга со скрином весит больше допустимого правилами форума
Можно картинку сохранить в хуже разрешении или вообще чб. Это можно сделать в любом графическом редакторе даже в Paint. Мой файл с картинкой занял всего 43кб.
Если не получается - давайте характеристики картинки: Размер начальной картинки. По сколько мм. отрезать снизу, сверху, слева, справа.
Книга со скрином весит больше допустимого правилами форума
Можно картинку сохранить в хуже разрешении или вообще чб. Это можно сделать в любом графическом редакторе даже в Paint. Мой файл с картинкой занял всего 43кб.
Если не получается - давайте характеристики картинки: Размер начальной картинки. По сколько мм. отрезать снизу, сверху, слева, справа.SLAVICK
еще вариант, с использованием Activex объектов Image эти объекты на листах "EUR USD","GBP USD", их можно копировать, включив режим конструктора, после копирования этих объектов или листов с ними нужно выполнить макрос init (Alt+F8>Двойной клик по init). Изображения обновляются из буфера обмена по двойному клику на них
[vba]
Код
Option Explicit Public WithEvents img As MSForms.Image Public self As ClsImg
Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (ByRef lpPictDesc As PicBmp, riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As Any) As Long Private Declare Function CloseClipboard Lib "user32.dll" () As Long Private Declare Function CopyImage Lib "user32.dll" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type
Private Sub Class_Initialize() Set self = Me End Sub
Private Sub img_DblClick(ByVal Cancel As MSForms.ReturnBoolean) PastePictureFromClipboard img End Sub
Private Function GetPicture(ByVal hPic As Long, ByVal PicType As Long) As IPictureDisp Dim p As PicBmp, g As GUID With p .hBmp = hPic .Size = Len(p) .Type = PicType End With With g .Data1 = &H7BF80980 .Data2 = &HBF32 .Data3 = &H101A .Data4(0) = &H8B .Data4(1) = &HBB .Data4(3) = &HAA .Data4(5) = &H30 .Data4(6) = &HC .Data4(7) = &HAB End With OleCreatePictureIndirect p, g, 1, GetPicture End Function
Private Sub PastePictureFromClipboard(ByRef img As Image) OpenClipboard 0 If IsClipboardFormatAvailable(2) Then Set img.Picture = GetPicture(CopyImage(GetClipboardData(2), 0, 0, 0, 0), 1) End If CloseClipboard End Sub
[/vba]
[vba]
Код
Public Sub init() Dim sh As Worksheet, obj As OLEObject, itm As ClsImg If Not col Is Nothing Then For Each itm In col Set itm.self = Nothing Next End If Set col = New Collection For Each sh In Sheets For Each obj In sh.OLEObjects If TypeOf obj.Object Is MSForms.Image Then Set itm = New ClsImg Set itm.img = obj.Object col.Add itm End If Next obj, sh End Sub
[/vba]
еще вариант, с использованием Activex объектов Image эти объекты на листах "EUR USD","GBP USD", их можно копировать, включив режим конструктора, после копирования этих объектов или листов с ними нужно выполнить макрос init (Alt+F8>Двойной клик по init). Изображения обновляются из буфера обмена по двойному клику на них
[vba]
Код
Option Explicit Public WithEvents img As MSForms.Image Public self As ClsImg
Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (ByRef lpPictDesc As PicBmp, riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As Any) As Long Private Declare Function CloseClipboard Lib "user32.dll" () As Long Private Declare Function CopyImage Lib "user32.dll" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type
Private Sub Class_Initialize() Set self = Me End Sub
Private Sub img_DblClick(ByVal Cancel As MSForms.ReturnBoolean) PastePictureFromClipboard img End Sub
Private Function GetPicture(ByVal hPic As Long, ByVal PicType As Long) As IPictureDisp Dim p As PicBmp, g As GUID With p .hBmp = hPic .Size = Len(p) .Type = PicType End With With g .Data1 = &H7BF80980 .Data2 = &HBF32 .Data3 = &H101A .Data4(0) = &H8B .Data4(1) = &HBB .Data4(3) = &HAA .Data4(5) = &H30 .Data4(6) = &HC .Data4(7) = &HAB End With OleCreatePictureIndirect p, g, 1, GetPicture End Function
Private Sub PastePictureFromClipboard(ByRef img As Image) OpenClipboard 0 If IsClipboardFormatAvailable(2) Then Set img.Picture = GetPicture(CopyImage(GetClipboardData(2), 0, 0, 0, 0), 1) End If CloseClipboard End Sub
[/vba]
[vba]
Код
Public Sub init() Dim sh As Worksheet, obj As OLEObject, itm As ClsImg If Not col Is Nothing Then For Each itm In col Set itm.self = Nothing Next End If Set col = New Collection For Each sh In Sheets For Each obj In sh.OLEObjects If TypeOf obj.Object Is MSForms.Image Then Set itm = New ClsImg Set itm.img = obj.Object col.Add itm End If Next obj, sh End Sub