Wie füge ich Fotos von meinem Computer zu bestimmten Zellen in meinem Excel-Arbeitsblatt hinzu? [geschlossen]

Dies ist der Code, den ich verwendet habe:

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

Ich möchte das genau machen:

• Wenn ich auf die Bildwerkzeuge in meinem Benutzerformular klicke, wenn ich ein Foto hinzufüge, sieht das so aus: (1)
• Wenn ich zwei Fotos hinzufüge, wird es automatisch zweiteilig und die Größe wird gleich sein wie: (2)
• Wenn ich drei Fotos hinzufüge, wird es automatisch dreiteilig sein und die Größe wird gleich sein wie: (3)

Ich möchte Fotos hinzufügen, wenn ich auf die Bildwerkzeuge in meinem Benutzerformular klicke. Sie erscheinen in den Excel-Arbeitsbereich-Zellen, die ich möchte (bestimmte Zellen, die ich möchte). Ich möchte vor allem Fotos zwischen 1-5 Zeilen und C - L Spalten hinzufügen, und automatisch wird ihre Größe gleich sein.

Ich habe diesen Code nur zum Hinzufügen verwendet. Ich kann nicht das tun, was ich gesagt habe:

Wenn ich diesen Code verwendet habe, sind Fotos in bestimmten Zellen nicht gleich, wenn ich möchte, und haben nicht die gewünschte Größe (links sind meine Benutzerformulare und Bildwerkzeuge, auf die ich klicke, rechts ist die Art, wie das Skript Fotos zum Arbeitsblatt hinzufügt )

Ich muss ihre Größe automatisch korrigieren. Bei Katz kann ich sie bestimmten Zellen hinzufügen, aber wenn ich ein Foto hinzufüge, fülle es die gewünschten Zellen nicht in der Größe aus oder wenn ich zwei Fotos hinzufüge, fülle ich die gewünschten Zellen nicht automatisch aus. Infolgedessen fügt dieses Skript Fotos zu Zelle und Größe hinzu, die ich in das Skript geschrieben habe. Sie werden nicht automatisch in bestimmten Zellen als gleich festgelegt. (Ich möchte gerne das erste Foto machen, aber ich kann bei diesem Drehbuch das zweite Foto machen.)

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

Soweit ich Ihre Frage verstanden habe, fehlt Ihnen ein Schlüsselelement: Bereiche haben Eigenschaften wie Links, Oben, Rechts und Breite, genau wie Bilder. Hier ist eine Funktion, die eine Range Das Objekt als Parameter fordert den Benutzer auf, Bilder auszuwählen, und passt die Bilder dann in diesen Bereich an. Entscheidender Punkt: Auf der Grundlage Ihrer Anfrage wird das Seitenverhältnis nicht beibehalten, sodass Bilder möglicherweise gestaucht oder gestreckt angezeigt werden.

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

AKTUALISIEREN: Soweit ich in Ihrer Frage sehen kann, habe ich denken So würden Sie es implementieren wollen.

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