Страницы: 1
RSS
Макрос. Вставка картинок, Проблемы с картинками
 
Добрый день,

Суть макроса в том, что бы определить два столбца с данными и для каждой полученной строки вставить картинку (путь к картинке присутствует в файле). Картинки сохранены на рабочем столе.
Проблема с выводом картинок:
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
 
Будьте любезны - оформите код специльным тэгом (на панели кнопка "<...>").
There is no knowledge that is not power
 
А почему бы не использовать готовое решение?
http://excelvba.ru/programmes/PastePictures
Одно нажатие кнопки, - и все картинки вставлены
 
Благодарю за ссылку. Она мне тогда очень помогла.
Прошу прощения за то, что так долго не отписывалась по вопросу.  
Страницы: 1
Наверх