Как добавить фотографии в определенные ячейки на листе Excel с моего компьютера?

Question

Это код, который я использовал:

Private Sub Image1_Click()
  Range("C1").Select
  Application.Dialogs(xlDialogInsertPicture).Show
End Sub


Private Sub Image2_Click()
  Range("D1").Select
  Application.Dialogs(xlDialogInsertPicture).Show
End Sub

Private Sub Image3_Click()
  Range("E1").Select
  Application.Dialogs(xlDialogInsertPicture).Show
End Sub

Private Sub Image4_Click()
  Range("F1").Select
 Application.Dialogs(xlDialogInsertPicture).Show
End Sub

Private Sub Image5_Click()
  Range("G1").Select
  Application.Dialogs(xlDialogInsertPicture).Show
End Sub

Private Sub Image6_Click()
  Range("K1").Select
  Application.Dialogs(xlDialogInsertPicture).Show
End Sub

Я хочу сделать это точно:

• Когда я нажимаю инструменты изображения в своей пользовательской форме, если добавить фотографию, она будет выглядеть так: (1)
• Когда я добавлю две фотографии, это будет автоматически две части и размер будет равен как: (2)
• Если я добавлю три фотографии, это будет автоматически три части и размер будет равен как: (3)

Я хочу добавлять фотографии, когда нажимаю на графические инструменты в своей пользовательской форме, они будут отображаться в нужных ячейках моего рабочего стола Excel (в определенных ячейках, которые я хочу). Я особенно хочу добавить фотографии между 1-5 строками и столбцами C - L, и автоматически их размер будет равен.

Я использовал этот код только для того, чтобы добавить, что я не могу сделать то, что сказал с этим:

Когда я использую этот код, фотографии не могут быть одинаковыми в определенных ячейках, когда я хочу, и не имеют определенного размера, который я хочу (слева - моя пользовательская форма и инструменты для работы с изображениями, которые я нажимаю, справа - как скрипт добавляет фотографии на рабочий лист )

Мне нужно исправить их размер автоматически. По сценарию Каца я могу добавить их в определенные ячейки, но если я добавлю фотографию, ее размер не заполняет нужные мне ячейки, или если я добавляю две фотографии, я не заполняю нужные ячейки автоматически. В результате этот скрипт добавляет фотографии в ячейку и размер, который я написал в сценарий. Не фиксируйте их автоматически в определенных ячейках как на равных. (Я хочу сделать как первое фото, но я могу по этому сценарию второе фото)

Private Sub Image1_Click()
Dim fileName1 As Variant
fileName1 = Application.GetOpenFilename(filefilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Choose picture", MultiSelect:=False)
    If fileName1 = False Then
    'if cancel pressed
    Exit Sub
Else
ActiveWorkbook.Sheets("Coursebooking").Select
Range("A4").Select 'choose your start range
Dim picture1 As Object
Set picture1 = ActiveWorkbook.Sheets("Coursebooking").Pictures.Insert(fileName1)
With picture1
    .Top = Range("A4").Top 'set as needed
    .Left = Range("A4").Left 'set as needed
    .Width = 600 'set as needed
    .Height = .Width * 3 / 4 'set as needed
End With
End If
End Sub

Answer 1

Из того, что я понимаю в вашем вопросе, вы упускаете ключевой элемент: диапазоны имеют свойства, такие как Left, Top, Right и Width, как изображения. Вот функция, которая принимает объект Range в качестве параметра, предлагает пользователю выбрать изображения и затем помещает изображения в этот диапазон. Ключевой момент: на основе вашего запроса написано, что соотношение сторон не поддерживается, поэтому изображения могут выглядеть сдавленными или растянутыми.

Option Explicit
Sub testImportPicturesToRange()
    ImportPicturesToRange Range("B3:H10")
End Sub
Function ImportPicturesToRange(rngTarget As Range)

    'Declaration
    Dim picFormats As String, picPaths, picPath, pic
    Dim i As Long, numPics As Long, picWidth As Long

    'Select the pictures to import
    picFormats = "*.gif; *.jpg; *.bmp; *.png; *.tif"
    picPaths = Application.GetOpenFilename("Pictures (" & picFormats & ")," & picFormats, , "Select Picture to Import", , True)

    'Exit if user clicked Cancel
    If TypeName(picPaths) = "Boolean" Then Exit Function

    'Initialize
    i = 0
    numPics = 0
    For Each picPath In picPaths
        If picPath <> False Then numPics = numPics + 1
    Next
    picWidth = rngTarget.Width / numPics

    'Import the pictures
    On Error Resume Next
    For Each picPath In picPaths
        If picPath <> False Then
            Set pic = ActiveSheet.Pictures.Insert(picPath)
            pic.ShapeRange.LockAspectRatio = msoFalse
            pic.Top = rngTarget.Top
            pic.Left = rngTarget.Left + (i * picWidth)
            pic.Height = rngTarget.Height
            pic.Width = picWidth
            i = i + 1
        End If
    Next

    'Cleanup
    Set pic = Nothing
    Set picPath = Nothing
    Set picPaths = Nothing

End Function

---

ОБНОВЛЕНИЕ: Из того, что я вижу в вашем вопросе, я думаю , что именно так вы хотели бы реализовать это.

Private Sub Image1_Click()
    ImportPicturesToRange Range("C1")
End Sub