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

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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