Помогите пожалуйста. Нужно сделать макрос, который будет вставлять картинку в примечание, причем в зависимости от значения в ячейке (1 \2 \3), картинка будет тоже меняться. Размер картинок будет разный, но известный заранее, поэтому эти параметры можно прописать руками. И еще одно условие, картинка должна изначально находиться в самом файле эксель, то есть подтягивать картинку откуда-то из папки на компьютере - не вариант. Файл прилагаю.
Помогите пожалуйста. Нужно сделать макрос, который будет вставлять картинку в примечание, причем в зависимости от значения в ячейке (1 \2 \3), картинка будет тоже меняться. Размер картинок будет разный, но известный заранее, поэтому эти параметры можно прописать руками. И еще одно условие, картинка должна изначально находиться в самом файле эксель, то есть подтягивать картинку откуда-то из папки на компьютере - не вариант. Файл прилагаю.KohaK
Sub Макрос_перенос_картинок() Dim A(3) As Integer Dim Shape1 As Shape Dim B(3) Dim Mashtab A(1) = Cells(7, 1) A(2) = Cells(7, 2) A(3) = Cells(7, 3) Set B(1) = Range(Cells(7, 7), Cells(10, 7)) Set B(2) = Range(Cells(7, 9), Cells(10, 9)) Set B(3) = Range(Cells(7, 12), Cells(10, 10)) For i = 1 To 3 For Each Shape1 In ActiveSheet.DrawingObjects.ShapeRange If Not Intersect(Range(Shape1.TopLeftCell, Shape1.BottomRightCell), B(A(i))) Is Nothing Then Shape1.Select End If Next Shape1 Selection.Copy Mashtab = Cells(8, i) With Selection.Copy Selection.ShapeRange.ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft End With Cells(9, i).Select ActiveSheet.Paste Next i End Sub
[/vba] тут использовал труды Alex_ST, чтобы научиться выделять картинки в выделенном диапазоне и макрорекордер. Ой, забыл сказать, вернее добавить файл Там, в строке "8" необходимо ставить масштаб, не в % а в единицах, тоесть, хотите увеличить в 2 раза, ставите 2 и тд..
KohaK, Примерно так попробуй. [vba]
Код
Sub Макрос_перенос_картинок() Dim A(3) As Integer Dim Shape1 As Shape Dim B(3) Dim Mashtab A(1) = Cells(7, 1) A(2) = Cells(7, 2) A(3) = Cells(7, 3) Set B(1) = Range(Cells(7, 7), Cells(10, 7)) Set B(2) = Range(Cells(7, 9), Cells(10, 9)) Set B(3) = Range(Cells(7, 12), Cells(10, 10)) For i = 1 To 3 For Each Shape1 In ActiveSheet.DrawingObjects.ShapeRange If Not Intersect(Range(Shape1.TopLeftCell, Shape1.BottomRightCell), B(A(i))) Is Nothing Then Shape1.Select End If Next Shape1 Selection.Copy Mashtab = Cells(8, i) With Selection.Copy Selection.ShapeRange.ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft End With Cells(9, i).Select ActiveSheet.Paste Next i End Sub
[/vba] тут использовал труды Alex_ST, чтобы научиться выделять картинки в выделенном диапазоне и макрорекордер. Ой, забыл сказать, вернее добавить файл Там, в строке "8" необходимо ставить масштаб, не в % а в единицах, тоесть, хотите увеличить в 2 раза, ставите 2 и тд..Roman777
Так же, замечу, что чтобы не было путаниц с картинками, лучше пошире сделать ширину столбцов, в которых лежит рисунок, чтобы рисунок лежал внутри столбца и не вылезал за границы его ширины (и ниже 10й строки тоже лежать не может, хотя может её касаться своим верхним краем). Заметил вот ещё, масштаб исходных картинок тоже почему-то меняется, не всегда, правда. Но как этого избежать, честно говоря, пока не знаю..)
Так же, замечу, что чтобы не было путаниц с картинками, лучше пошире сделать ширину столбцов, в которых лежит рисунок, чтобы рисунок лежал внутри столбца и не вылезал за границы его ширины (и ниже 10й строки тоже лежать не может, хотя может её касаться своим верхним краем). Заметил вот ещё, масштаб исходных картинок тоже почему-то меняется, не всегда, правда. Но как этого избежать, честно говоря, пока не знаю..)Roman777
Roman777, спасибо, что откликнулись) Но ваш макрос делает не совсем то, что нужно. Нужно чтобы картинки вставлялись в Примечание в ячейке, а сейчас они вставляются просто как картинки на 9 строке экселя. При этом после каждого запуска макроса, исходные картинки увеличиваются в размере...
Roman777, спасибо, что откликнулись) Но ваш макрос делает не совсем то, что нужно. Нужно чтобы картинки вставлялись в Примечание в ячейке, а сейчас они вставляются просто как картинки на 9 строке экселя. При этом после каждого запуска макроса, исходные картинки увеличиваются в размере...KohaK
KohaK, По поводу вставить в Примечания, к сожалению, у меня даже руками не получается картинку туда пихнуть. Ответа пока не могу дать. Мб попозже ещё вернусь к вопросу, сейчас просто времени нет углубиться и почитать что про это пишут.
KohaK, По поводу вставить в Примечания, к сожалению, у меня даже руками не получается картинку туда пихнуть. Ответа пока не могу дать. Мб попозже ещё вернусь к вопросу, сейчас просто времени нет углубиться и почитать что про это пишут.Roman777
Serge_007, Спасибо за подсказку. Посмотрел, действительно ставится... и даже коды нашёл, но везде подгрузка картинки идёт не из файла, а из внешнего источника, хотя если файл эксель переименовать в рар, там можно найти те же картинки, что внутри хранятся... но пока что меня это особо не на что не навело и в данной задаче никак не получается исполнить сиё присоединение картинки из файла в примечание. Но подсказка полезная, ибо никак не получалось мне в формате найти эту вкладку заливки, пока не ткнул на границу примечания.
Serge_007, Спасибо за подсказку. Посмотрел, действительно ставится... и даже коды нашёл, но везде подгрузка картинки идёт не из файла, а из внешнего источника, хотя если файл эксель переименовать в рар, там можно найти те же картинки, что внутри хранятся... но пока что меня это особо не на что не навело и в данной задаче никак не получается исполнить сиё присоединение картинки из файла в примечание. Но подсказка полезная, ибо никак не получалось мне в формате найти эту вкладку заливки, пока не ткнул на границу примечания.Roman777
Доброе время суток Roman777 В принципе, можно организовать хранение картинок внутри скрытого листа книги, используя его как ресурс. И по названию файла извлекать во временную папку. [vba]
Код
Public Sub StoreFile(ByVal FileName As String) Dim pSheet As Worksheet, fSize As Long Dim vData() As Byte, fNum As Integer Dim fso As New Scripting.FileSystemObject
Set pSheet = ThisWorkbook.Worksheets(1) fSize = fso.GetFile(FileName).Size ReDim vData(1 To fSize) fNum = FreeFile Open FileName For Binary As #fNum Get #fNum, , vData Close #fNum pSheet.CustomProperties.Add FileName, vData End Sub
Public Function GetResourceName(ByVal ResourceName As String) As String Dim i As Long, sName As String, fso As New Scripting.FileSystemObject Dim pCProp As CustomProperty, pSheet As Worksheet Dim vData() As Byte, fNum As Integer Set pSheet = ThisWorkbook.Worksheets(1) sName = "" For i = 1 To pSheet.CustomProperties.Count Set pCProp = pSheet.CustomProperties(i) If StrComp(pCProp.Name, ResourceName, vbTextCompare) = 0 Then sName = pCProp.Name Exit For End If Next If sName <> "" Then i = InStrRev(sName, "\") sName = fso.GetSpecialFolder(2) & Mid$(sName, i) If Not fso.FileExists(sName) Then vData = pCProp.Value fNum = FreeFile Open sName For Binary As #fNum Put #fNum, , vData Close #fNum End If End If GetResourceName = sName End Function
[/vba] Естественно, требуемые картинки следует сначала загрузить, а потом выгружать по ключу. В коде примера FileName = ResourceName для поиска требуемой сохранённой картинки
Доброе время суток Roman777 В принципе, можно организовать хранение картинок внутри скрытого листа книги, используя его как ресурс. И по названию файла извлекать во временную папку. [vba]
Код
Public Sub StoreFile(ByVal FileName As String) Dim pSheet As Worksheet, fSize As Long Dim vData() As Byte, fNum As Integer Dim fso As New Scripting.FileSystemObject
Set pSheet = ThisWorkbook.Worksheets(1) fSize = fso.GetFile(FileName).Size ReDim vData(1 To fSize) fNum = FreeFile Open FileName For Binary As #fNum Get #fNum, , vData Close #fNum pSheet.CustomProperties.Add FileName, vData End Sub
Public Function GetResourceName(ByVal ResourceName As String) As String Dim i As Long, sName As String, fso As New Scripting.FileSystemObject Dim pCProp As CustomProperty, pSheet As Worksheet Dim vData() As Byte, fNum As Integer Set pSheet = ThisWorkbook.Worksheets(1) sName = "" For i = 1 To pSheet.CustomProperties.Count Set pCProp = pSheet.CustomProperties(i) If StrComp(pCProp.Name, ResourceName, vbTextCompare) = 0 Then sName = pCProp.Name Exit For End If Next If sName <> "" Then i = InStrRev(sName, "\") sName = fso.GetSpecialFolder(2) & Mid$(sName, i) If Not fso.FileExists(sName) Then vData = pCProp.Value fNum = FreeFile Open sName For Binary As #fNum Put #fNum, , vData Close #fNum End If End If GetResourceName = sName End Function
[/vba] Естественно, требуемые картинки следует сначала загрузить, а потом выгружать по ключу. В коде примера FileName = ResourceName для поиска требуемой сохранённой картинкиanvg
anvg, Спасибо большое, я вот тоже думал, что выходом тут может быть "выкорчевывание" из файла картинок в папку. Но неужели тут только так, ведь, по-сути, файлы (картинки) уже есть, зачем их сначало доставать, чтобы потом вставить всёравно внутрь...) как-то неразумно получается. Да и ваш код мне пока кажется трудным и непонятным, надо поизучать). Можете подсказать что такое "#fNum"?
anvg, Спасибо большое, я вот тоже думал, что выходом тут может быть "выкорчевывание" из файла картинок в папку. Но неужели тут только так, ведь, по-сути, файлы (картинки) уже есть, зачем их сначало доставать, чтобы потом вставить всёравно внутрь...) как-то неразумно получается. Да и ваш код мне пока кажется трудным и непонятным, надо поизучать). Можете подсказать что такое "#fNum"?Roman777
Но неужели тут только так, ведь, по-сути, файлы (картинки) уже есть, зачем их сначало доставать
Вы же сами провели анализ
Цитата
даже коды нашёл, но везде подгрузка картинки идёт не из файла, а из внешнего источника
только лучше было бы написать "не из файла", а из книги. Увы, но [vba]
Код
Comment.Shape.Fill.UserPicture "d:\path\name.jpg"
[/vba] Предполагает наличие файла-картинки. Можно, конечно, скопировать файл-книги (будет работать только для версий файла 2007), переименовав в архив zip и, используя Shell.Application, вытащить оттуда изображения в какую-нибудь временную папку (из архива UserPicutere не возьмёт). Только чем это будет отличаться от выше предложенного? По поводу #fNum, вот ссылка по стандарным методам работы с файлами в VBA, думаю вы легко разберётесь. Успехов.
Доброе время суток.
Цитата
Но неужели тут только так, ведь, по-сути, файлы (картинки) уже есть, зачем их сначало доставать
Вы же сами провели анализ
Цитата
даже коды нашёл, но везде подгрузка картинки идёт не из файла, а из внешнего источника
только лучше было бы написать "не из файла", а из книги. Увы, но [vba]
Код
Comment.Shape.Fill.UserPicture "d:\path\name.jpg"
[/vba] Предполагает наличие файла-картинки. Можно, конечно, скопировать файл-книги (будет работать только для версий файла 2007), переименовав в архив zip и, используя Shell.Application, вытащить оттуда изображения в какую-нибудь временную папку (из архива UserPicutere не возьмёт). Только чем это будет отличаться от выше предложенного? По поводу #fNum, вот ссылка по стандарным методам работы с файлами в VBA, думаю вы легко разберётесь. Успехов.anvg
Сообщение отредактировал anvg - Вторник, 14.04.2015, 08:00
KohaK, Добрый день! В кратце. Макрос экспортирует картинки в папку, где содержится книга экселевская, оттуда импортит в примечание картинку. Далее картинка из папки удаляется). Если отменить удаление картинки из папки после её загрузки в примечание, данный макрос не будет работать, ибо тогда необходимо будет тогда отслеживать какие из картинок в папке мы уже прикрепляли. Сначала необходимо выделить ячейки, к которым необходимо прицепить примечание. Потом выделить столбцы, где содержатся картинки, я предполагал, что столбцы будут выделены одним диапазоном (а не несколькими смежными). Но можно выделять все столбцы и пустые и заполненные картинками (таким образом в файле-примере выделяешь сначала ячейки A7,B7,C7, а потом выделяешь область G:L). Косяков там наверняка много и всякие штуки "от дураков" я не делал, поэтому написал тут небольшую инструкцию))).
KohaK, Добрый день! В кратце. Макрос экспортирует картинки в папку, где содержится книга экселевская, оттуда импортит в примечание картинку. Далее картинка из папки удаляется). Если отменить удаление картинки из папки после её загрузки в примечание, данный макрос не будет работать, ибо тогда необходимо будет тогда отслеживать какие из картинок в папке мы уже прикрепляли. Сначала необходимо выделить ячейки, к которым необходимо прицепить примечание. Потом выделить столбцы, где содержатся картинки, я предполагал, что столбцы будут выделены одним диапазоном (а не несколькими смежными). Но можно выделять все столбцы и пустые и заполненные картинками (таким образом в файле-примере выделяешь сначала ячейки A7,B7,C7, а потом выделяешь область G:L). Косяков там наверняка много и всякие штуки "от дураков" я не делал, поэтому написал тут небольшую инструкцию))).Roman777
Проблемы. 1. Макрос срабатывает только пока в нужных ячейках не вставлены примечания. Когда примечания уже стоят, то повторный запуск макроса приводит к ошибке, в тексте сообщения написано "400". 2. Совершенно не нужен интерфейс выбора диапазонов ячеек. Нужно заранее прописать, что ячейки, в которые нужно вставить картинку в примечании находятся на листе 1 в диапазонах C3:U3 W3:Z3 C6:U6 W6:AA6, а исходные картинки находятся на листе 2, (картинок будет много). Также нужно убрать ячейки с масштабом с листа 1 на лист 2. На листе 2. в принципе. можно размещать все как будет удобно. Лист 2 должен быть скрыт. 3. И самая главная проблема, даже если изначально в ячейках нет примечания и макрос отрабатывает успешно, то примечание появляется, но вот картинка в примечании не всегда появляется. То есть появляется пустое примечание.
Я вот подумал, если изначально сложно выделить картинку, то может быть будет удобно сделать так. Создать фигуру и фоном в этой фигуре поставить картинку. То есть фигуры же в экселе имеют имя и может быть станет проще вызвать картинки, находящиеся в этих фигурах... хотя картинки тоже вроде имеют имя... в общем, если что, то не надо в меня тапками кидать, это просто мысль))
Roman777, спасибо, что не сдаетесь))
Проблемы. 1. Макрос срабатывает только пока в нужных ячейках не вставлены примечания. Когда примечания уже стоят, то повторный запуск макроса приводит к ошибке, в тексте сообщения написано "400". 2. Совершенно не нужен интерфейс выбора диапазонов ячеек. Нужно заранее прописать, что ячейки, в которые нужно вставить картинку в примечании находятся на листе 1 в диапазонах C3:U3 W3:Z3 C6:U6 W6:AA6, а исходные картинки находятся на листе 2, (картинок будет много). Также нужно убрать ячейки с масштабом с листа 1 на лист 2. На листе 2. в принципе. можно размещать все как будет удобно. Лист 2 должен быть скрыт. 3. И самая главная проблема, даже если изначально в ячейках нет примечания и макрос отрабатывает успешно, то примечание появляется, но вот картинка в примечании не всегда появляется. То есть появляется пустое примечание.
Я вот подумал, если изначально сложно выделить картинку, то может быть будет удобно сделать так. Создать фигуру и фоном в этой фигуре поставить картинку. То есть фигуры же в экселе имеют имя и может быть станет проще вызвать картинки, находящиеся в этих фигурах... хотя картинки тоже вроде имеют имя... в общем, если что, то не надо в меня тапками кидать, это просто мысль))KohaK
ЗЫ Все оказалось гораздо проще)) Нужно просто изначально создать ячейки со всеми возможными вариантами примечаний, а потом просто копировать нужные примечания в нужные ячейки)
А вообще, Roman777, еще раз спасибо, что помогали)
ЗЫ Все оказалось гораздо проще)) Нужно просто изначально создать ячейки со всеми возможными вариантами примечаний, а потом просто копировать нужные примечания в нужные ячейки)
А вообще, Roman777, еще раз спасибо, что помогали)KohaK
Я вот подумал, если изначально сложно выделить картинку, то может быть будет удобно сделать так. Создать фигуру и фоном в этой фигуре поставить картинку. То есть фигуры же в экселе имеют имя и может быть станет проще вызвать картинки, находящиеся в этих фигурах... хотя картинки тоже вроде имеют имя... в общем, если что, то не надо в меня тапками кидать, это просто мысль))
Вы правы, название картинок я и так достаю, в общем то макрос по названию и работает. Проблема в том, что загрузку макросом в примечания я нашёл только следующим способом: [vba]
Код
.Cells(A.Row, A.Columns(i).Column).AddComment.Shape.Fill.UserPicture "Полный адрес картинки"
[/vba] А он требует ссылаться на внешний файл. Именно поэтому приходится сначала сохранять "наружу", а потом загонять в примечание.
Ну а чтобы ошибки с примечаниями не делались, можно поставить проверку на их наличие и удалить предварительно перед созданием нового примечания. С диапазонами было бы сложнее, у вас диапазоны "C3:U3 W3:Z3 C6:U6 W6:AA6" несмежные, пришлось бы исправлять код и скорее всего использовать "Area" вместо Range. Ну а насчёт не вставленных картинок, я не знаю с чем это связано. Возможно, Ваша картинка лежала не внутри определённого столбца. Мб причина в другом. В любом случае, Вы нашли удобное для Вас решение.
Я вот подумал, если изначально сложно выделить картинку, то может быть будет удобно сделать так. Создать фигуру и фоном в этой фигуре поставить картинку. То есть фигуры же в экселе имеют имя и может быть станет проще вызвать картинки, находящиеся в этих фигурах... хотя картинки тоже вроде имеют имя... в общем, если что, то не надо в меня тапками кидать, это просто мысль))
Вы правы, название картинок я и так достаю, в общем то макрос по названию и работает. Проблема в том, что загрузку макросом в примечания я нашёл только следующим способом: [vba]
Код
.Cells(A.Row, A.Columns(i).Column).AddComment.Shape.Fill.UserPicture "Полный адрес картинки"
[/vba] А он требует ссылаться на внешний файл. Именно поэтому приходится сначала сохранять "наружу", а потом загонять в примечание.
Ну а чтобы ошибки с примечаниями не делались, можно поставить проверку на их наличие и удалить предварительно перед созданием нового примечания. С диапазонами было бы сложнее, у вас диапазоны "C3:U3 W3:Z3 C6:U6 W6:AA6" несмежные, пришлось бы исправлять код и скорее всего использовать "Area" вместо Range. Ну а насчёт не вставленных картинок, я не знаю с чем это связано. Возможно, Ваша картинка лежала не внутри определённого столбца. Мб причина в другом. В любом случае, Вы нашли удобное для Вас решение.Roman777
Вот, чутка доработал. Скрыл 2й лист, где картинки и собственно, сделал, чтобы он не ругался, если числа введёные будут не 1,2,3 и если будет примечание. А несмежные ячейки, когда надо выделить что-то типа "C3:U3 W3:Z3 C6:U6 W6:AA6" данный макрос не поддерживает. Мб когда-нибудь попробую это доработать...) Или кто-нить, кому не лень сделает).
Вот, чутка доработал. Скрыл 2й лист, где картинки и собственно, сделал, чтобы он не ругался, если числа введёные будут не 1,2,3 и если будет примечание. А несмежные ячейки, когда надо выделить что-то типа "C3:U3 W3:Z3 C6:U6 W6:AA6" данный макрос не поддерживает. Мб когда-нибудь попробую это доработать...) Или кто-нить, кому не лень сделает).Roman777