Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
`Вставить Примечание` - заливка картинки., Как в уже имеющийся макрос прикрутить “msoFileDialogFilePicker” ?
 
#1
02.08.2019 15:51:06
Имеем это:
Код
Sub Special_Note2_FillPicture(control As IRibbonControl)
    Dim myComm As Comment
      If Not ActiveCell.Comment Is Nothing Then
        If MsgBox("Ячейка уже содержит примечание, удалить?", 4) - 7 Then
          ActiveCell.Comment.Delete
        Else: Exit Sub
        End If
      End If

    Set myComm = ActiveCell.AddComment
        With myComm.Shape 'выставляем требуемый формат
          .Height = 110
          .Width = 200
          .AutoShapeType = 1             'форма
'          .Fill.UserTextured
          .Fill.UserPicture "C:\Users\Admin\Downloads\TEST.jpg" 'Вставить картинку
          .Line.ForeColor.RGB = RGB(255, 0, 0) 'цвет линии
          .DrawingObject.Font.Name = "Consolas" 'шрифт
          .DrawingObject.Font.FontStyle = "обычный"
          .DrawingObject.Font.Size = 8    'размер шрифта
        End With
          'эмулируем выбор пункта "Изменить примечание"
           SendKeys "+{F2}"
End Sub

Хочу на место этого:

Код
.Fill.UserPicture "C:\Users\Admin\Downloads\TEST.jpg" 'Вставить картинку

Прикрутить открытие окна с выбором картинки которая на ПК:

Код
Application.FileDialog(msoFileDialogFilePicker)

С уважением!

Если не бегаешь, пока здоров, придется побегать, когда заболеешь.
 
 
 
#2
02.08.2019 17:32:06
https://excelvba.ru/code/PictureInCellComment
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
02.08.2019 19:35:28
Игорь,
Благодарю уважаемый!  Сделал вот так:
Код
Sub AddImage()
    Dim ImaFile$
    Dim myComm As Comment
 
    If Selection.Cells.Count > 1 Then Exit Sub
    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        ImaFile = .SelectedItems(1)
    End With
 
  On Error GoTo nexterr
  ActiveCell.ClearComments
  
    Set myComm = ActiveCell.AddComment
        With myComm.Shape
          .Height = 110
          .Width = 200
          .AutoShapeType = 1             'форма
'          .Fill.UserTextured
          .Fill.UserPicture (ImaFile) 'Переменная в которой уже по сути наша картинка.
          .Line.ForeColor.RGB = RGB(255, 0, 0) 'цвет линии
          .DrawingObject.Font.Name = "Consolas" 'шрифт
          .DrawingObject.Font.FontStyle = "обычный"
          .DrawingObject.Font.Size = 8
          Exit Sub
nexterr:
    MsgBox "Можно выбирать только изображения!", vbCritical, "Ошибка"
    ActiveCell.ClearComments
        End With
          'эмулируем выбор пункта "Изменить примечание"
'           SendKeys "+{F2}", True
End Sub

Но тут почему то не работает `Hotkey` (гуглил-гуглил но ничего дельного не нагуглил). Это нажатие на клавиши `Shift+F2` ··· показать/скрыть примечание:
Код
SendKeys "+{F2}"
Шеф вы не подскажите решение или новую Тему открыть для этого?
Изменено: rediffusion - 02.08.2019 19:37:55
Если не бегаешь, пока здоров, придется побегать, когда заболеешь.
 
 
 
#4
02.08.2019 19:38:07
Это не хоткей
Там написано для чего эта строка кода
Она не нужна, потому и отключена

Хоткей в другом месте задаётся
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#5
02.08.2019 19:59:36
Игорь,
Она нужна я её закомментировал так как не робит.
В каком другом?
Если не бегаешь, пока здоров, придется побегать, когда заболеешь.
 
 
 
#6
04.08.2019 21:35:18
Игорь,
Решение найдено прошу глянуть реализацию:
Код
'Заливка картинкой в `Заметку` (диалог):
Sub Note_FiilPictureDialog(control As IRibbonControl)
    Dim img As FileDialog
    Dim i_add As String
    Dim myComm As Comment

    Set img = Application.FileDialog(msoFileDialogFilePicker)
        img.AllowMultiSelect = False
        img.Title = "Выберите изображение!"
        img.Show

    If img.SelectedItems.Count < 1 Then
    Exit Sub

    Else
        i_add = img.SelectedItems(1)
    End If

'Если ячейка содержит `Заметку` удаляем!
    If Not ActiveCell.Comment Is Nothing Then
        ActiveCell.Comment.Delete
    End If

    On Error GoTo nexterr
    ActiveCell.ClearComments

    Set myComm = ActiveCell.AddComment
        With myComm.Shape
          .Height = 110
          .Width = 200
          .AutoShapeType = 1             'форма
'          .Fill.UserTextured
          .Fill.UserPicture i_add        'Заливка картинкой.
          .Line.ForeColor.RGB = RGB(255, 0, 0)
          .DrawingObject.Font.Name = "Consolas"
          .DrawingObject.Font.FontStyle = "normal"
          .DrawingObject.Font.Size = 8
          
          'Эмулировать выбор "Изменить `Заметку`".
           SendKeys "+{F2}"
          Exit Sub
          
nexterr:
        MsgBox "Можно выбирать только изображения!", vbCritical, "Ошибка"
        ActiveCell.ClearComments
        End With
End Sub
Если не бегаешь, пока здоров, придется побегать, когда заболеешь.
 
 
 
Страницы: 1
Читают тему
Наверх