Экспорт картинок с Excel

@boooeller · Регистрация: 02.02.2019

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

Добрый день. Подскажите пожалуйста, у меня такая задача, нужно экспортировать картинки с excel в папку но так чтобы потом в этом документе сделать ссылки на эти картинки для дальнейшей загрузки файла на сайт, можно например экспортировать картинки так чтобы они назывались текстом с другого столбца:
https://prnt.sc/rpiog7

?

@Narimanych · 30.03.2020, 19:40

boooeller,
Можете прислать копию файла с 2мя-3-мя строчками?

@boooeller · 30.03.2020, 21:39 **[ТС]**

Сообщение от Narimanych

boooeller,
Можете прислать копию файла с 2мя-3-мя строчками?

вот пожалуйста

@Narimanych · 30.03.2020, 22:15

boooeller,

Для файла , который вы прикрепили...

Visual Basic

Sub MMM()
Application.ScreenUpdating = False
On Error Resume Next
For i = 12 To Cells(Rows.Count, 2).End(xlUp).Row
    For Each sh In ActiveSheet.Shapes
    If sh.Top >= Cells(i, 3).Top And sh.Top < Cells(i, 3).Top + Cells(i, 3).Height Then
               If sh.Left >= Cells(i, 3).Left And sh.Left < Cells(i, 3).Left + Cells(i, 3).Width Then
                    PTH = ("C:\Desctop\TEST\" & Cells(i, 7).Value & ".jpg")  ' здесь укажите путь (path) к  вашей папке вместо  "C:\Desctop\TEST\"-не забудьте про backslash в конце...
                         Set ch = ActiveSheet.ChartObjects.Add(0, 0, sh.Width, sh.Height)
                         Set chArea = ch.Chart
                         sh.CopyPicture
                    With chArea
                      .ChartArea.Select
                      .Paste
                      .Export (PTH)
                    End With
                    ch.Delete
         Cells(i, 4).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 7), Address:=PTH, TextToDisplay:=Cells(i, 7).Value
                    
    End If
    End If
    Next
Next
Application.ScreenUpdating = True
MsgBox "Task Complete"
End Sub

@boooeller · 31.03.2020, 00:07 **[ТС]**

Сообщение от Narimanych

boooeller,

Для файла , который вы прикрепили...

Visual Basic

Sub MMM()
Application.ScreenUpdating = False
On Error Resume Next
For i = 12 To Cells(Rows.Count, 2).End(xlUp).Row
    For Each sh In ActiveSheet.Shapes
    If sh.Top >= Cells(i, 3).Top And sh.Top < Cells(i, 3).Top + Cells(i, 3).Height Then
               If sh.Left >= Cells(i, 3).Left And sh.Left < Cells(i, 3).Left + Cells(i, 3).Width Then
                    PTH = ("C:\Desctop\TEST\" & Cells(i, 7).Value & ".jpg")  ' здесь укажите путь (path) к  вашей папке вместо  "C:\Desctop\TEST\"-не забудьте про backslash в конце...
                         Set ch = ActiveSheet.ChartObjects.Add(0, 0, sh.Width, sh.Height)
                         Set chArea = ch.Chart
                         sh.CopyPicture
                    With chArea
                      .ChartArea.Select
                      .Paste
                      .Export (PTH)
                    End With
                    ch.Delete
         Cells(i, 4).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 7), Address:=PTH, TextToDisplay:=Cells(i, 7).Value
                    
    End If
    End If
    Next
Next
Application.ScreenUpdating = True
MsgBox "Task Complete"
End Sub

Спасибо Вам большое!

@boooeller · 09.04.2020, 10:40 **[ТС]**

Narimanych,

Для файла , который вы прикрепили...

Visual Basic

Sub MMM()
Application.ScreenUpdating = False
On Error Resume Next
For i = 12 To Cells(Rows.Count, 2).End(xlUp).Row
    For Each sh In ActiveSheet.Shapes
    If sh.Top >= Cells(i, 3).Top And sh.Top < Cells(i, 3).Top + Cells(i, 3).Height Then
               If sh.Left >= Cells(i, 3).Left And sh.Left < Cells(i, 3).Left + Cells(i, 3).Width Then
                    PTH = ("C:\Desctop\TEST\" & Cells(i, 7).Value & ".jpg")  ' здесь укажите путь (path) к  вашей папке вместо  "C:\Desctop\TEST\"-не забудьте про backslash в конце...
                         Set ch = ActiveSheet.ChartObjects.Add(0, 0, sh.Width, sh.Height)
                         Set chArea = ch.Chart
                         sh.CopyPicture
                    With chArea
                      .ChartArea.Select
                      .Paste
                      .Export (PTH)
                    End With
                    ch.Delete
         Cells(i, 4).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 7), Address:=PTH, TextToDisplay:=Cells(i, 7).Value
                    
    End If
    End If
    Next
Next
Application.ScreenUpdating = True
MsgBox "Task Complete"
End Sub

[/QUOTE]

Подскажите пожалуйста, можно сделать что то подобное чтобы картинки скачивались по ссылке в папку?

@boooeller 0 / 0 / 0 Регистрация: 02.02.2019 Сообщений: 69
		1
	Экспорт картинок с Excel 30.03.2020, 17:51. Показов 2151. Ответов 5 Метки excel, excel vba (Все метки) Добрый день. Подскажите пожалуйста, у меня такая задача, нужно экспортировать картинки с excel в папку но так чтобы потом в этом документе сделать ссылки на эти картинки для дальнейшей загрузки файла на сайт, можно например экспортировать картинки так чтобы они назывались текстом с другого столбца: https://prnt.sc/rpiog7 ? 0

@Narimanych 2724 / 1701 / 776 Регистрация: 23.03.2015 Сообщений: 5,388
	30.03.2020, 19:40	2
	boooeller, Можете прислать копию файла с 2мя-3-мя строчками? 0

	09.04.2020, 10:40

Экспорт картинок с Excel

Решение