1

Всем привет!

Такая проблема: есть xml-файл, внутри которого таблица. Одно из полей таблицы- изображение. Каждый раз идти по пути "вставка-изображение" не удобно. Кто знает макрос, который размещает в углу ячейки значок "+" по которому мы клацаем и появляется окно проводника для выбора фотографии. ?

И еще одно проблема в тему: тот же самый "+", но только он должен добавлять новую строку(с заданными значениями ширины и высоты ячеек).

Надеюсь на Вашу помощью.

1 ответ 1

2

Процедура открытия диалога для выбора файлов:

Sub OpenPictureDialog()
    With Application.FileDialog(msoFileDialogOpen)
        .ButtonName = "Выбрать изображение"
        .Title = "Добавить выбранное изображение"
        ' Начальный каталог с изображениями
        .InitialFileName = "C:\Users\admin\Pictures\"
        .Filters.Clear
        ' Фильтр изображений, в данном случае только *.jpeg, *.jpg
        .Filters.Add "Файлы изображений", "*.jp*"
        If .Show <> -1 Then Exit Sub
        ActiveSheet.Pictures.Insert(.SelectedItems(1)).Select
        PS = Application.PathSeparator
    End With
End Sub

Если нужно вставлять картинку непосредственно в саму ячейку, то лучше добавить еще макрос отсюда.

Процедура открытия формы с полями ввода:

Sub InsertRow()
    ' Показываем форму ввода ширины/высоты ячеек
    AddRow.Show
End Sub

Основной макрос, который вызывает предыдущие процедуры и рисует кнопку:

Sub AddButton()
    Dim btnX1, btnX2, btnY1, btnY2 As Integer
    Dim padding As Integer
    Dim r, rH, c, cW As Integer

    padding = 3
    r = ActiveCell.row - 1
    rH = 0
    c = ActiveCell.Column - 1
    cW = 0

    For i = 1 To r
        rH = rH + Rows(i).Height
    Next i

    For i = 1 To c
        cW = cW + Columns(i).Width
    Next i

    ' Координаты кнопки в ячейке
    btnX1 = cW + padding
    btnY1 = rH + padding
    btnX2 = ActiveCell.Height - padding * 2
    btnY2 = ActiveCell.Height - padding * 2

    ' Добавляем кнопку в активную ячейку
    ActiveSheet.Buttons.Add(btnX1, btnY1, btnX2, btnY2).Select

    ' Добавляем выбранную картинку на страницу
    ' Selection.OnAction = "OpenPictureDialog"

    ' Вставляем новую строку под активной ячейкой
    ' Selection.OnAction = "InsertRow"

    Selection.Caption = "+"
End Sub

В зависимости от требований, раскомментируйте либо Selection.OnAction = "OpenPictureDialog", либо Selection.OnAction = "InsertRow"

Сама форма ввода:

введите сюда описание изображения

Код для кнопки OK:

Private Sub InsertButton_Click()
    If CellWidth.Text = "" Or CellHeight.Text = "" Then
        MsgBox ("Значение не указано!")
    End If

    Rows(ActiveCell.row + 1).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.RowHeight = Val(CellHeight.Text)
    Selection.ColumnWidth = Val(CellWidth.Text)

    Close
End Sub

Ваш ответ

Нажимая на кнопку «Отправить ответ», вы соглашаетесь с нашими пользовательским соглашением, политикой конфиденциальности и политикой о куки

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.