Импорт изображений / изображений из закрытой книги Excel с использованием VBA

Question

Я копирую csv-файлы и изображения из сетевой папки на разные листы temporary Excel workbook. Я использую эти temporary workbook до slice/dice the csv data и resize the pictures, помещенные в лист.

Я хочу импортировать эти изображения из этой CLOSED temporary workbook в мою current Workbook ИЛИ импортировать complete Sheet в мою current Workbook. Я могу импортировать все другие листы, содержащие текстовые данные csv с ADODB recordset, но не могу импортировать изображения.

• Есть ли способ импортировать эти изображения without opening the temporary workbook?
• Есть ли в ADO method to import pictures, встроенный в ячейки листа Excel закрытой книги Excel?
• Есть ли в Excel какой-либо элемент управления изображением, в котором все изображения могут быть изначально сохранены во временной книге а затем импортированы обратно в мою текущую рабочую книгу?
• Есть ли способ импортировать / копировать лист изображения из closed temporary workbook в current workbook?

Спасибо.

Answer 1

Откуда исходят фотографии? Я предполагаю, что они не исходят из Excel, верно. Я, конечно, не знаю вашей полной настройки, но если у вас есть куча изображений в папке, и вы хотите импортировать все в лист Excel, вы можете использовать приведенный ниже код, чтобы сделать это.

Sub InsertPics()
Dim fPath As String, fName As String
Dim r As Range, rng As Range

Application.ScreenUpdating = False
fPath = "C:\your_path\"
Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
i = 1
For Each r In rng
    fName = Dir(fPath)
    Do While fName <> ""
            With ActiveSheet.Pictures.Insert(fPath & fName)
                .ShapeRange.LockAspectRatio = msoTrue
                Set px = .ShapeRange
                If .ShapeRange.Width > Rows(i).Columns(2).Width Then .ShapeRange.Width = Columns(2).Width
                    With Cells(i, 2)
                        px.Top = .Top
                        px.Left = .Left
                        .RowHeight = px.Height
                    End With
            End With
            i = i + 1
        fName = Dir
    Loop
Next r
Application.ScreenUpdating = True
End Sub