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

1733
John Nash

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

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
1
У меня есть скриншот, но мне нужно 10 репутации, чтобы добавить его сюда John Nash 9 лет назад 0
Кроме того, это не сайт "Пожалуйста, напишите мне сценарий". Если у вас есть проблемы с вашим скриптом, который ведет себя не так, как должен, и вы не можете понять, почему, опубликуйте свой скрипт, и мы посмотрим, что пойдет не так. На данный момент нет сценария. Можете ли вы отредактировать свой вопрос и опубликовать сценарий VBA, который вы написали? LPChip 9 лет назад 0
я добавляю к коду сейчас @LPChip John Nash 9 лет назад 0
Пожалуйста, опубликуйте весь код, а не только тот, который, по вашему мнению, выдает ошибку. LPChip 9 лет назад 0
С помощью этого кода я просто добавляю фотографии. Но я не могу исправить, какие ячейки я добавлю, и я не могу исправить их размер тоже. Я думаю, что я сказал это ясно, и я показываю, что я имел в виду в ссылке тоже .. @LPChip John Nash 9 лет назад 0
Я новичок в SuperUser, но неправильно ли мне публиковать ответы «напиши мне сценарий», потому что мне нравится их озадачивать? Должен ли я остановиться, потому что это вызывает плохие вопросы? Engineer Toast 9 лет назад 1

1 ответ на вопрос

2
Engineer Toast

From what I understand of your question, you're missing a key piece: Ranges have properties like Left, Top, Right, and Width just like images do. Here's a function that takes in a Range object as a parameter, prompts the user to select images, and then fits the images into that range. Key Point: Based on your request, it is written so that aspect ratio is not maintained so pictures may appear squashed or stretched.

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: From what I can see in your question, I think this is how you would want to implement it.

Private Sub Image1_Click() ImportPicturesToRange Range("C1") End Sub
Как добавить в скрипт инструменты для работы с изображениями? @Engineer Toast John Nash 9 лет назад 0
Я обновил свой ответ, чтобы показать пример, основанный на примере кода в вашем вопросе. Engineer Toast 9 лет назад 0

Похожие вопросы