Добрый день,
Суть макроса в том, что бы определить два столбца с данными и для каждой полученной строки вставить картинку (путь к картинке присутствует в файле). Картинки сохранены на рабочем столе.
Проблема с выводом картинок:
1. нужно зациклить действие для всех заполненных строк имеющейся таблицы
2. нужно уменьшить размер картинки до размера ячейки
Помогите пожалуйста!| Код |
|---|
Sheets("Лист1").Select
Sheets("Лист1").Copy
Columns("D:D").Select
Selection.Replace What:="*_", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="/", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("H1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(R1C18,R1C4,"".jpg"")"
Range("H1").Select
Selection.AutoFill Destination:=Range("H1:H6"), Type:=xlFillDefault
Range("H1:H6").Select
Columns("H:H").ColumnWidth = 37
Range("H1:H6").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Лист1").Select
SheetRows = ActiveWorkbook.ActiveSheet.cells.SpecialCells(xlCellTypeLastCell).Row
ColRows = Application.WorksheetFunction.CountA(Range(cells(1, 1), cells(SheetRows, 3)))
ItRows = 1
For i = 2 To ColRows
Sheets("Лист1").Select
FotoTov = Range("H" & i).Value
Sheets("Лист1").Select
Strok = ItRows
ItRows = Strok
Range("J" & Strok).Select
With ActiveSheet.Pictures.Insert(FotoTov).Select
.Top = [J1].Top
.Left = [J1].Left
End With
Next i |
