Como adicionar fotos a células específicas na minha planilha do Excel do meu computador? [fechadas]

Question

Este é o código que eu usei:

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

Eu quero fazer exatamente isso:

• Quando clico nas ferramentas de imagem no meu formulário de usuário, se adicionar uma foto, será como: (1)
• Quando eu adiciono duas fotos, será automaticamente duas partes e tamanho será igual como: (2)
• Se eu adicionar três fotos, elas serão automaticamente três partes e o tamanho será igual a: (3)

Eu quero adicionar fotos quando clico nas ferramentas de imagem no meu userform, elas aparecerão nas minhas células do excel workseet que eu quero (células específicas que eu quero). Eu particularmente quero adicionar fotos entre 1-5 linhas e colunas C - L e automaticamente seu tamanho será igual.

Eu usei este código apenas para adicionar Eu não posso fazer o que eu disse com isso:

Quandoeuuseiessecódigo,asfotosnãosãoiguaisemcélulasespecíficasquandoeuqueroenãoestounotamanhoespecíficoqueeuquero(esquerdaéomeuuserformeferramentasdeimagemqueeuclico,certoécomooscriptadicionarfotosparaplanilha)

Eu preciso corrigir seu tamanho automaticamente. No script do Katz eu posso adicioná-los a células específicas, mas se eu adicionar uma foto é tamanho não preenche as células que eu quero ou se eu adicionar duas fotos não preenche automaticamente as células que eu quero. Como resultado, este script adiciona fotos à célula e tamanho que eu escrevi para o script. Não corrigi-los automaticamente em células específicas como iguais. (Eu quero fazer como primeira foto, mas eu posso neste roteiro segunda foto)

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

Pelo que entendi da sua pergunta, você está perdendo uma peça-chave: os intervalos têm propriedades como Esquerda, Superior, Direita e Largura, assim como as imagens. Aqui está uma função que recebe um objeto Range como um parâmetro, solicita ao usuário selecionar imagens e, em seguida, ajusta as imagens nesse intervalo. Ponto-chave: Com base na sua solicitação, ela é gravada para que a proporção não seja mantida, portanto, as imagens podem aparecer esmagadas ou esticadas.

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

UPDATE: Pelo que vejo na sua pergunta, penso que é assim que você gostaria de implementá-lo.

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