|
- Sub 插入图片test()
- Dim fso As Object
- Dim fd As Object
- Dim ff As Object
- Dim picPath$
- picPath = "C:\Users\Keivn\Desktop\pic" '图片路径,此路径只放图片,不可以有其它类型的文件,如果有要修改代码另作判断
- Set fso = CreateObject("scripting.filesystemobject")
- Set fd = fso.getfolder(picPath)
- Dim picArr
- Dim picCount%, n%
- picCount = fd.Files.Count
- ReDim picArr(1 To picCount)
- n = 1
- For Each ff In fd.Files
- picArr(n) = ff.Path
- n = n + 1
- Next
-
- Dim myCell As Cell
- Dim myTable As Table
- Dim myDoc As Document
- Set myDoc = ActiveDocument
- Dim Rng As Range
- n = 1
- For Each myTable In myDoc.Tables
- For Each myCell In myTable.Range.Cells
- If Len(myCell.Range.Text) = 2 Then
- Set Rng = myCell.Range
- Rng.InlineShapes.AddPicture filename:=picArr(n), LinkToFile:=False, SaveWithDocument:=True
- With Rng.InlineShapes(1)
- .LockAspectRatio = msoFalse
- .Height = 184.8
- .Width = 246.6
- End With
- n = n + 1
- If n > UBound(picArr) Then End
- End If
- Next
- Next
- End Sub
复制代码
|
|