word中vba批量插入圖片

⑴ 怎麼批量把圖片放到WORD里並附上該圖的名稱

Sub 選擇重命名文件夾()

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker) '運行後出現標準的選擇文件夾對話框

If .Show Then myPath = .SelectedItems(1) Else Exit Sub '如選中則返回=-1 / 取消未選則返回=0

End With

If Right(myPath, 1) <> "" Then myPath = myPath & ""

'返回的是選中目標文件夾的絕對路徑,但除了本地C 盤、D 盤會以"C:"形式返回外，其餘路

徑無""需要自己添加

Getfd (myPath)

Application.ScreenUpdating = True

End Sub

Sub Getfd(ByVal pth)

On Error Resume Next

Dim strPath As String

'插入兩行

Columns("A:B").Select

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

'設置B 行內容

Range("B1") = "目標名稱"

Range("B2").Select

ActiveCell.FormulaR1C1 = "=RC[1]&"" ""&RC[2]&"".JPG""" '設置B 行內容為目標名稱

Range("B2").Select

m = Range("C65536").End(xlUp).Row

Selection.AutoFill Destination:=Range("B2:B" & m) '填充B 行

'設置A 行內容為所選文件下所有圖譜名稱

Range("A1") = "原名稱"

strPath = pth & "\"

f = Dir(strPath & "*.jpg")

k = 1

Do While f <> ""

k = k + 1

Range("A" & k) = f

f = Dir

Loop

'調整AB 列寬

Cells.Select

Cells.EntireColumn.AutoFit '調整AB 列寬

'重命名

a = Cells(Cells.Rows.Count, 1).End(xlUp).Row + 3 'A 列最後可見單元的行號

For b = 2 To a

c = Range("a" & b).Value

cc = Range("b" & b).Value

Name strPath & c As strPath & cc '重命名

Next

MsgBox ("重命名完成")

End Sub

⑵ 關於圖片批量導入word中並在圖片上方附加文件名的VBA代碼編輯

Sub 批量插入圖片()
Dim myfile As FileDialog
Set myfile = Application.FileDialog(msoFileDialogFilePicker)
With myfile
.InitialFileName = "E:\工作文件" 『這里輸入你要插入圖片的目標文件夾
If .Show = -1 Then
For Each Fn In .SelectedItems
Selection.Text = Basename(Fn) '這兩句移到這里
Selection.EndKey
If Selection.Start = ActiveDocument.Content.End - 1 Then '如游標在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Set MyPic = Selection.InlineShapes.AddPicture(FileName:=Fn, SaveWithDocument:=True) '按比例調整相片尺寸
WidthNum = MyPic.Width
c = 6 '在此處修改相片寬,單位厘米
MyPic.Width = c * 28.35
MyPic.Height = (c * 28.35 / WidthNum) * MyPic.Height
If Selection.Start = ActiveDocument.Content.End - 1 Then '如游標在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Next Fn
Else
End If
End With
Set myfile = Nothing
End Sub
Function Basename(FullPath) '取得文件名
Dim x, y
Dim tmpstring
tmpstring = FullPath
x = Len(FullPath)
For y = x To 1 Step -1
If Mid(FullPath, y, 1) = "\" Or _
Mid(FullPath, y, 1) = ":" Or _
Mid(FullPath, y, 1) = "/" Then
tmpstring = Mid(FullPath, y + 1)
Exit For
End If
Next
Basename = Left(tmpstring, Len(tmpstring) - 4)
End Function
執行此代碼後，彈出的選擇對話框， 全選目標文件夾下的所有圖片文件之後，點擊確定。然後靜靜的等待電腦完成處理工作，次數word會進入無響應狀態。圖片越多，無響應的時間越長。

⑶ 想在word頁面中，批量插入圖片，使得每頁有4張圖片均勻分布在頁面中，該怎麼做呢

這是統一設置word文檔中的圖片樣式，你的問題我不會，但是希望這個例子會對你有點提示。

使用宏：
一,在word中按alt+f11組合鍵,進入VBA模式
二,在左邊的工程資源管理器中找到你的word文檔,在其上右鍵/添加/模塊
三,把下面代碼復制,粘貼進去.
四,更改數值, 改一下寬度和高度數值(10)，點運行(類似播放按鈕.)或f5,即可設置文檔中全部圖片
Sub Macro()
Mywidth=10'10為圖片寬度（厘米）
Myheigth=10'10為圖片高度（厘米）
For Each iShape In ActiveDocument.InlineShapes
iShape.Height = 28.345 * Myheigth
iShape.Width = 28.345 * Mywidth
Next iShape
End Sub

⑷ word如何設置宏批量插入圖片到word表格里（每一行2到3個表格）

郵件合並功能，應該是不能實現的吧。
採用簡單的VBA宏編程，針對具體的表格格式，很容易實現的。可以hi我。

⑸ 用vba如何批量插入圖片,公式詳解

您好，根據您的需求，批量插入圖片的參考代碼如下：

OptionExplicit

PublicSub批量插入圖片()
DimrngPictureAsRange

DimlngRowAsLong
DimintColAsInteger

WithActiveSheet
ForlngRow=1To16Step8
ForintCol=1To12Step3
SetrngPicture=.Cells(lngRow+1,intCol+2)
笑好rngPicture.Select

With.Pictures.Insert("E:坑圖"&rngPicture.Value&".jpg").ShapeRange
.Height=70.5
.Width=105
EndWith
Next
Next
EndWith

SetrngPicture=Nothing
EndSub

PS：具體使用時請自行粗升源修改演示代碼中的循環起止行、起止列和步進值。如果圖片插入到單元格後出現偏移，請設岩態置 Picture 的 Left 屬性和 Top 屬性。

另外，也可以設置圖片在單元格內水平居中（比單元格大的圖片暫不考慮），參考代碼如下：

OptionExplicit

PublicSub批量插入圖片水平居中()
DimrngPictureAsRange

DimlngRowAsLong
DimintColAsInteger

WithActiveSheet
ForlngRow=1To16Step8
ForintCol=1To12Step3
SetrngPicture=.Cells(lngRow+1,intCol+2)
rngPicture.Select

With.Pictures.Insert("E:坑圖"&rngPicture.Value&".jpg").ShapeRange
.Left=rngPicture.Left+(rngPicture.Width-.Width)/2
.Top=rngPicture.Top+(rngPicture.Height-.Height)/2
EndWith
Next
Next
EndWith

SetrngPicture=Nothing
EndSub

⑹ word用vba批量導入圖片文件時，怎樣保留圖片原有大小，而不是統一固定大小跪謝！下為您原來提供的代碼

試試把
MyPic.Width = c * 28.35
MyPic.Height = (c * 28.35 / WidthNum) * MyPic.Height
改為
'MyPic.Width = c * 28.35
'MyPic.Height = (c * 28.35 / WidthNum) * MyPic.Height

⑺ 在word中自動插入圖片 vba代碼

Sub 批量插入圖片()
Dim myfile As FileDialog
Set myfile = Application.FileDialog(msoFileDialogFilePicker)
With myfile
.InitialFileName = "E:\工作文件" 『這里輸入你要插入圖片的目標文件夾
If .Show = -1 Then
For Each Fn In .SelectedItems
Selection.Text = Basename(Fn) '這兩句移到這里
Selection.EndKey
If Selection.Start = ActiveDocument.Content.End - 1 Then '如游標在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Set MyPic = Selection.InlineShapes.AddPicture(FileName:=Fn, SaveWithDocument:=True) '按比例調整相片尺寸
WidthNum = MyPic.Width
c = 6 '在此處修改相片寬,單位厘米
MyPic.Width = c * 28.35
MyPic.Height = (c * 28.35 / WidthNum) * MyPic.Height
If Selection.Start = ActiveDocument.Content.End - 1 Then '如游標在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Next Fn
Else
End If
End With
Set myfile = Nothing
End Sub
Function Basename(FullPath) '取得文件名
Dim x, y
Dim tmpstring
tmpstring = FullPath
x = Len(FullPath)
For y = x To 1 Step -1
If Mid(FullPath, y, 1) = "\" Or _
Mid(FullPath, y, 1) = ":" Or _
Mid(FullPath, y, 1) = "/" Then
tmpstring = Mid(FullPath, y + 1)
Exit For
End If
Next
Basename = Left(tmpstring, Len(tmpstring) - 4)
End Function
執行此代碼後，彈出的選擇對話框， 全選目標文件夾下的所有圖片文件之後，點擊確定。然後靜靜的等待電腦完成處理工作，次數word會進入無響應狀態。圖片越多，無響應的時間越長。

⑻ 利用VBA如何將批量圖片導入WORD的指定表格格式里

將excel表格中的數據批量插入到word中的操作方法：
1、單擊插入----對象按鈕；
2、彈出插入對話框對話框，選擇由文件創建對話框，單擊瀏覽按鈕；
3、彈出瀏覽對話框，選擇需要插入有Excel文件；
4、單擊插入按鈕即可。
註：
（1）若選中鏈接到文件，源文件修改，Word中的表格也隨之改變；
（2）若選中顯示為圖片，則以圖標的形式插入到Word，雙擊可以打開其源文件。

⑼ vba關於批量插入圖片

批量插入圖片代碼：
sub 圖片導入
dim s as shape
dim rg as range
'刪除已有的圖片
for each s in activesheet.shapes
if s.type <> 8 then
s.delete
end if
'導入圖片
for each rg in range("B2:B10")'這里放要插入圖片的單元格範圍 B2:B10可以改成所需要的范圍。
activesheet.shapes.addshape(msoshaperectangle,rg.left,rg.top,rg.width,rg.height).select
selection.shaperange.fill.userpicture "E:\圖片"& rg.offset(0, -1) & ".jpg"'這里指定的是圖片的存儲路徑為E盤下的圖片文件夾，然後圖片名稱與A列的數據一致，後綴名為JPG格式。這些都可以自行更改，根據需要來定。
next rg
end sub

⑽ 尋找WORD VBA高手解決WORD批量插入圖片程序的問題

Selection.Text = Basename(Fn) '這兩句移到這里
Selection.EndKey

這兩句移一下位置，其它不變。

Sub 批量插入圖片()
Dim myfile As FileDialog
Set myfile = Application.FileDialog(msoFileDialogFilePicker)
With myfile
.InitialFileName = "D:\111"
If .Show = -1 Then
For Each Fn In .SelectedItems
Selection.Text = Basename(Fn) '這兩句移到這里
Selection.EndKey
Set mypic = Selection.InlineShapes.AddPicture(FileName:=Fn, SaveWithDocument:=True)
'按比例調整相片尺寸
WidthNum = mypic.Width
c = 18 '在此處修改相片寬,單位厘米
mypic.Width = c * 28.35
mypic.Height = (c * 28.35 / WidthNum) * mypic.Height
If Selection.Start = ActiveDocument.Content.End - 1 Then '如游標在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
If Selection.Start = ActiveDocument.Content.End - 1 Then '如游標在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Next Fn
Else
End If
End With
Set myfile = Nothing
End Sub
Function Basename(FullPath) '取得文件名
Dim x, y
Dim tmpstring
tmpstring = FullPath
x = Len(FullPath)
For y = x To 1 Step -1
If Mid(FullPath, y, 1) = "\" Or _
Mid(FullPath, y, 1) = ":" Or _
Mid(FullPath, y, 1) = "/" Then
tmpstring = Mid(FullPath, y + 1)
Exit For
End If
Next
Basename = Left(tmpstring, Len(tmpstring) - 4)
End Function