hmanhha Ответов: 1

Как поместить картинку в диапазон в excell vba.

Я прочитал ссылку здесь.


[^]


Но теперь пользователь хочет изменить, чтобы поместить картинку в выбранный диапазон.

Как я могу его изменить?

Спасибо всем.

Что я уже пробовал:

Dim myRange As Range
  Dim width, height As Integer

  m = ActiveCell.Row
  n = ActiveCell.Column
  MyCol = ActiveCell.Column
  mystring = Selection.Address(False, False)
  MsgBox (mystring)
  Set myRange = Selection
  width = myRange.width
  height = myRange.height
  Dim fd As FileDialog

  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  With fd
      .Filters.Clear
      .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
      .ButtonName = "Select"
      .AllowMultiSelect = False
      .Title = "Choose Photo"
      .InitialView = msoFileDialogViewDetails
      .Show
  End With
  ActiveSheet.Range(mystring).Select
  ActiveSheet.Shapes.AddPicture Filename:=fd.SelectedItems(1), _
  LinkToFile:=msoFalse, _
  SaveWithDocument:=msoCTrue, _
  Left:=ActiveSheet.Range("photograph2").Left + 2, _
  Top:=ActiveSheet.Range("photograph2").Top + 2, _
  width:=width, _
  height:=height

Maciej Los

Что не так с вашим кодом?

hmanhha

Я не знаю, как изменить размер изображений, чтобы соответствовать диапазону, который выбирает пользователь. Спасибо.

1 Ответов

Рейтинг:
11

Maciej Los

Я проверил это:

Option Explicit 'force variable declaration


Sub InsertImageIntoSelection()
    'variables
    Dim rng As Range, wsh As Worksheet
    Dim sFileName As String
    
    'in case of error goto error handler
    On Error GoTo Err_InsertImageIntoSelection
    
    'get selection
    Set rng = Application.Selection
    'get worksheet
    Set wsh = rng.Parent
    'define filename
    sFileName = "C:\SomeImage.jpg"
    'add image into selection
    wsh.Shapes.AddPicture sFileName, msoFalse, msoTrue, _
                rng.Left, rng.Top, rng.Width, rng.Height
    
Exit_InsertImageIntoSelection:
    On Error Resume Next 'ignore errors
    'clean up!
    Set rng = Nothing
    Set wsh = Nothing
    Exit Sub
    
Err_InsertImageIntoSelection:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_InsertImageIntoSelection
End Sub

и это прекрасно работает!