Question

我有一个插件，用于根据文章名称将图像插入到表格中。

插件有4个用户表单，用于选择带图片的文件夹，选择需要填充图片的范围的第一个和最后一个单元格。

问题是插件正在插入图片。我想改变它，所以我可以将图片保存在我的文件中。

问题在于，插件是由一个土耳其人制作的，并且里面有一些土耳其语。这是插件的网址

https://www.wetransfer.com/downloads/8a48cdd32edec6abcb6d211f6b40f0dd20141227212931/02691e435d5e047478b8cc3e4df49dd420141227212931/e46ba7

这是插件的最后一部分

Range(ResimSutun & ilkSatir & ":" & ResimSutun & SonSatir).Select
Selection.RowHeight = ResimYukseklik

Range(ArticleSutun & ilkSatir).Select

Do 

ilkAdr = Selection.Address
Adres1 = Right(ilkAdr, Len(ilkAdr) - 3)
On Error Resume Next
ImageName = Range(ArticleSutun & Adres1).Value

Select Case Len(ImageName)

Case 1
    ImageName = "00000" & ImageName
Case 2
    ImageName = "0000" & ImageName
Case 3
    ImageName = "000" & ImageName
Case 4
    ImageName = "00" & ImageName
Case 5
    ImageName = "0" & ImageName

End Select

Range(ResimSutun & Adres1).Select

ActiveSheet.Shapes.AddPicture(Filename:=FolderName & "\" & ImageName & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=1, _
    Top:=1, Width:=30, Height:=50).Select

If Selection.Width > Selection.Height Then Olcek = Selection.Width Else Olcek = Selection.Height

Selection.ShapeRange.IncrementLeft 3.75
Selection.ShapeRange.IncrementTop 2.25
Selection.ShapeRange.ScaleWidth (ResimYukseklik * 0.9 / Olcek), msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight (ResimYukseklik * 0.9 / Olcek), msoFalse, msoScaleFromTopLeft

Range(ResimSutun & Adres1 + 1).Select
Loop Until Adres1 = SonSatir
End Sub

我需要更改哪些内容，以便根据其他列中的名称在每个单元格中添加图片？

此致

Answer 1

我发现我为代码工作的解决方案。也许它不是最好的，但是它可以工作。

    Dim Response As Integer
    Dim MyPic As String
    Dim rng As Range
    Dim shp As Shape
    Dim rng1 As Range

    Response = MsgBox("Keep Pictures inside the file? Warning,_
     file will get bigger!", vbYesNo + vbQuestion, "Keep Pictures")

    If Response = vbYes Then
    Range(ArticleSutun & ilkSatir).Select

    Do

    ilkadr = Selection.Address
    adres1 = Right(ilkadr, Len(ilkadr) - 3)

    On Error Resume Next

    imagename = Range(ArticleSutun & adres1).Value
    Select Case Len(imagename)

    Case 1
          imagename = "00000" & imagename

    Case 2
          imagename = "0000" & imagename

    Case 3
          imagename = "000" & imagename

    Case 4
          imagename = "00" & imagename

    Case 5
          imagename = "0" & imagename

    End Select

    MyPic = FolderName & "\" & imagename & ".jpg"
    Range(ResimSutun & adres1).Select
    xColIndex = Application.ActiveCell.Column
    xRowIndex = Application.ActiveCell.Row
    Set rng1 = Cells(xRowIndex, xColIndex)
    Set shp = ActiveSheet.Shapes.AddPicture(MyPic, False, True,_
 rng1.Left, rng1.Top, rng1.Width, rng1.Height)

    Range(ResimSutun & adres1 + 1).Select
    Loop Until adres1 = SonSatir

    else

将图片添加到Excel vba

1 个答案: