Страница 1 из 2
ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 16 июл 2009, 11:22
Menshikov
Добрый день, уважаемые эксперты!
Очень нужна Ваша помощь в создании макроса.
По роду занятий, мне постоянно приходиться вставлять картинки JPG в лист Excel по 100-200 штук в день, занятие крайне трудоемкое, есть ли возможность его упростить с помощью макроса.
Пример:
1. Лист Excel со столбцами: № п.п., артикул, наименование, цена, фото. (пример приложен к теме)
Ширина столбца фото 248 пискел, высота всех сток 165 пиксел, именно это и есть размер необходимого изображения в столбце фото, приходиться вставлять по одной фотографии и подгонять ее по размерам, потом сжимать, чтобы вес файла уменьшить, занятие безумное и занимает очень много времени.
Есть одна постоянная название каждой фотографии, соответствует номеру артикула напротив ячейки, где она должна находиться, возможно ли автоматизировать этот процесс с помощью макроса, я конечно не силен в этой теме, но вот как мне это видится, к примеру я создал лист, вставил все данные (№, артикул, наименование, цена), создал столбик фото растянул все столбы и стоки до необходимого размера и «волшебство» с помощью макроса из общей папки со всеми фото на рабочем столе я втягиваю фотографии в соответствии с их названием, т.е. в стоку где артикул равен имени фото и возможно ли чтобы фотографии сразу уменьшались до размера ячейки????
ГУРУ ПРОГРАМИРОВАНИЕ – ПОМОГИТЕ!!!!!
Re: ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 16 июл 2009, 14:41
airyashov
незнаю с какой системой вы работайте, но такое довольно просто написать на 1с 8,а затем сохранить в лист excel
Re: ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 16 июл 2009, 14:45
Menshikov
airyashov писал(а):незнаю с какой системой вы работайте, но такое довольно просто написать на 1с 8,а затем сохранить в лист excel
Добрый день, тема закрыта.
Мне уже помогли с написание макроса.
Спасибо за внимание.
Re: ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 16 июл 2009, 14:55
airyashov
а не можите выложить здесь посмотреть сколько приходилось работать, с картинками в excel не очень удобно.
Re: ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 16 июл 2009, 15:05
Menshikov
airyashov писал(а):а не можите выложить здесь посмотреть сколько приходилось работать, с картинками в excel не очень удобно.
Добрый день, а как его выложить, управление вложениями не пускает файл к прикреплению, вот макрос:
Sub Vstavka_Kartinok()
Sheets("Лист1").Select
x = 1
Range("A1").Select
While Sheets("Лист1").Cells(x, 2).Text <> ""
x = x + 1
Wend
x = x - 1
For i = 2 To x
kartinka = Sheets("Лист1").Cells(i, 2).Value
Range("E" & CStr(i)).Select
ActiveSheet.Pictures.Insert("C:\Documents and Settings\R_Menshikov\Рабочий стол\Photo\" & CStr(kartinka) & ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 152.2
Selection.ShapeRange.Width = 183.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
Next i
MsgBox ("Фото успешно вставлены")
End Sub
Есть одна проблема, он работает в Excel 2003, в Excel 2007 работает не корректно, может кто может помочь с адаптацией, макрос должен вставлять каждую картинку напротив ячейки с ее цифровым значением, в 2007 он сваливает их все в одну кучу.
Помогите если можете.
Re: ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 16 июл 2009, 15:11
airyashov
спасибо, так и думал через select, попробую на 2007
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
для 2007
попробуйте подобрать параметры
Код: Выделить всё
Sub Vstavka_Kartinok()
Sheets("Ëèñò1").Select
x = 1
Range("A1").Select
While Sheets("Ëèñò1").Cells(x, 2).Text <> ""
x = x + 1
Wend
x = x - 1
For i = 2 To x
kartinka = Sheets("Ëèñò1").Cells(i, 2).Value
Range("E" & CStr(i)).Select
Dim SR As ShapeRange
ActiveSheet.Pictures.Insert("C:\1\" & CStr(kartinka) & ".jpg").Select
'Set SR = Selection.ShapeRange
[B]Selection.ShapeRange.Left = 200
Selection.ShapeRange.Top = 100 * (i - 2)[/B]
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 152.2
Selection.ShapeRange.Width = 183.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
Next i
MsgBox ("Ôîòî óñïåøíî âñòàâëåíû")
End Sub
Sub InsertShapeNode()
ActiveSheet.Shapes(1).Select
With Selection.ShapeRange
If .Type = msoFreeform Then
.Nodes.Insert _
Index:=3, SegmentType:=msoSegmentCurve, _
EditingType:=msoEditingSymmetric, X1:=35, Y1:=100
.Fill.ForeColor.RGB = RGB(0, 0, 200)
.Fill.Visible = msoTrue
Else
MsgBox "This shape is not a Freeform object."
End If
End With
End Sub
Re: ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 16 июл 2009, 21:47
Menshikov
airyashov писал(а):спасибо, так и думал через select, попробую на 2007
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
для 2007
попробуйте подобрать параметры
Код: Выделить всё
Sub Vstavka_Kartinok()
Sheets("Ëèñò1").Select
x = 1
Range("A1").Select
While Sheets("Ëèñò1").Cells(x, 2).Text <> ""
x = x + 1
Wend
x = x - 1
For i = 2 To x
kartinka = Sheets("Ëèñò1").Cells(i, 2).Value
Range("E" & CStr(i)).Select
Dim SR As ShapeRange
ActiveSheet.Pictures.Insert("C:\1\" & CStr(kartinka) & ".jpg").Select
'Set SR = Selection.ShapeRange
[B]Selection.ShapeRange.Left = 200
Selection.ShapeRange.Top = 100 * (i - 2)[/B]
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 152.2
Selection.ShapeRange.Width = 183.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
Next i
MsgBox ("Ôîòî óñïåøíî âñòàâëåíû")
End Sub
Sub InsertShapeNode()
ActiveSheet.Shapes(1).Select
With Selection.ShapeRange
If .Type = msoFreeform Then
.Nodes.Insert _
Index:=3, SegmentType:=msoSegmentCurve, _
EditingType:=msoEditingSymmetric, X1:=35, Y1:=100
.Fill.ForeColor.RGB = RGB(0, 0, 200)
.Fill.Visible = msoTrue
Else
MsgBox "This shape is not a Freeform object."
End If
End With
End Sub
Спасибо за труды, но я не так силен в макросах, какие параметры необходимо подобрать?
Что необходимо прописать в макросе.
У Вас работает макрос в Excel 2007?
Re: ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 16 июл 2009, 22:47
airyashov
вот эти, можите кинуть файл excel с установленными параметрами хотябы для 1 ячейки, т.е. полностью 1 строка сформатированная как нужно
Selection.ShapeRange.Left =
Selection.ShapeRange.Top =
Re: ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 16 июл 2009, 23:07
Menshikov
airyashov писал(а):вот эти, можите кинуть файл excel с установленными параметрами хотябы для 1 ячейки, т.е. полностью 1 строка сформатированная как нужно
Selection.ShapeRange.Left =
Selection.ShapeRange.Top =
Добрый вечер, конечно я могу выслать файл, но файлы Excel к сообщению не прикрепляются, сообщите вашу электронную почту.
Re: ВСТАВКА ФОТО В ЛИСТ EXCEL С ПОМОЩЬЮ МАКРОСА (НУЖНА ПОМОЩЬ!)
Добавлено: 17 июл 2009, 08:11
airyashov
почта в подписи