Добрый день,
Суть макроса в том, что бы определить два столбца с данными и для каждой полученной строки вставить картинку (путь к картинке присутствует в файле). Картинки сохранены на рабочем столе.
Проблема с выводом картинок:
1. нужно зациклить действие для всех заполненных строк имеющейся таблицы
2. нужно уменьшить размер картинки до размера ячейки
Помогите пожалуйста!
Суть макроса в том, что бы определить два столбца с данными и для каждой полученной строки вставить картинку (путь к картинке присутствует в файле). Картинки сохранены на рабочем столе.
Проблема с выводом картинок:
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 |
Изменено: stran9e - 21.12.2015 20:49:49