① 在Word中表格內批量插入文字與圖片的vb程序
新建一個文檔，文檔中插入圖片採用附件中的拖拽插入方法（可以保證插入的圖片順序），然後用替換功能將所有圖片後面添加一個回車符【ctrl+h調出替換對話框
查找內容輸入：(?)
替換為輸入：\1^p
高級或更多選擇「使用通配符」，點擊全部替換】
然後ctrl+a選中所有圖片，點擊插入→表格→表格，即可將所有圖片放到一個表格的一列中，然後復制這個表格，並選擇你現在問的中需要插入圖片的列（最好復制的圖片列和選中的需要插入圖片的列的行數相同），然後粘貼即可。
② vb中如何在word文檔中插入圖形文件
Dim MyWord As Object
Dim NewDoc As Object
Set MyWord = CreateObject("Word.Application") '創建一個word對象
M = App.Path & "\123.doc"
Set NewDoc = MyWord.Documents.Open(M)
Clipboard.Clear '清除剪貼板
Clipboard.SetData Picture1.Picture 'vbCFBitmap 圖片框中圖片裝入剪貼板
MyWord.Selection.TypeText "123" & "." & vbCr '換行
MyWord.Selection.Paste '將剪貼板中的圖像復制到Word文檔中
MyWord.Selection.TypeText (vbCrLf) '換行
NewDoc.Content.InsertAfter "123" & "." & vbCr
Set NewDoc = Nothing
Set MyWord = Nothing '清除對象
③ 急求：在vb中利用replace向word中插入圖片的問題
在VB6.0中，操作word，使用它強大的查找、替換、刪除、復制、翦切功能。還可以把特定字元替換成圖片。有了它你就可以使用資料庫中的內容或圖片文件替換word文件中的特定字元。
只要把下列內容復制到寫字板中，另存為SetWord.cls文件，然後在把它添加到工程中，就可以使用了。
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "SetWord"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private mywdapp As Word.Application
Private mysel As Object
'屬性值的模塊變數
Private C_TemplateDoc As String
Private C_newDoc As String
Private C_PicFile As String
Private C_ErrMsg As Integer
Public Event HaveError()
Attribute HaveError.VB_Description = "出錯時激發此事件.出錯代碼為ErrMsg屬性"
'***************************************************************
'ErrMsg代碼：1－word沒有安裝 2 - 缺少參數 3 - 沒許可權寫文件
' 4 - 文件不存在
'
'***************************************************************
Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0) As Integer
Attribute ReplacePic.VB_Description = "查找FindStr,並替換為PicFile所指向的圖片文件,替換次數由time參數確定,為0時，替換所有"
'********************************************************************************
' 從Word.Range對象mysel中查找所有FindStr，並替換為PicFile圖像
' 替換次數由time參數確定，為0時，替換所有
'********************************************************************************
If Len(C_PicFile) = 0 Then
C_ErrMsg = 2
Exit Function
End If
Dim i As Integer
Dim findtxt As Boolean
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
With mysel.Find
.Text = FindStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
mysel.HomeKey Unit:=wdStory
findtxt = mysel.Find.Execute(Replace:=True)
If Not findtxt Then
ReplacePic = 0
Exit Function
End If
i = 1
Do While findtxt
mysel.InlineShapes.AddPicture FileName:=C_PicFile
If i = Time Then Exit Do
i = i + 1
mysel.HomeKey Unit:=wdStory
findtxt = mysel.Find.Execute(Replace:=True)
Loop
ReplacePic = i
End Function
Public Function FindThis(FindStr As String) As Boolean
Attribute FindThis.VB_Description = "查找FindStr,如果模板中有FindStr則返回True"
If Len(FindStr) = 0 Then
C_ErrMsg = 2
Exit Function
End If
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
With mysel.Find
.Text = FindStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
mysel.HomeKey Unit:=wdStory
FindThis = mysel.Find.Execute
End Function
Public Function ReplaceChar(FindStr As String, RepStr As String, Optional Time As Integer = 0) As Integer
Attribute ReplaceChar.VB_Description = "查找FindStr,並替換為RepStr,替換次數由time參數確定,為0時，替換所有"
'********************************************************************************
' 從Word.Range對象mysel中查找FindStr，並替換為RepStr
' 替換次數由time參數確定，為0時，替換所有
'********************************************************************************
Dim findtxt As Boolean
If Len(FindStr) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Function
End If
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
With mysel.Find
.Text = FindStr
.Replacement.Text = RepStr
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
If Time > 0 Then
For i = 1 To Time
mysel.HomeKey Unit:=wdStory
findtxt = mysel.Find.Execute(Replace:=wdReplaceOne)
If Not findtxt Then Exit For
Next
If i = 1 And Not findtxt Then
ReplaceChar = 0
Else
ReplaceChar = i
End If
Else
mysel.Find.Execute Replace:=wdReplaceAll
End If
End Function
Public Function GetPic(PicData() As Byte, FileName As String) As Boolean
Attribute GetPic.VB_Description = "把圖像數據PicData,存為PicFile指定的文件"
'********************************************************************************
' 把圖像數據PicData,存為PicFile指定的文件
'********************************************************************************
On Error Resume Next
If Len(FileName) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Function
End If
Open FileName For Binary As #1
If Err.Number <> 0 Then
C_ErrMsg = 3
Exit Function
End If
'二進制文件用Get,Put存放，讀取數據
Put #1, , PicData
Close #1
C_PicFile = FileName
GetPic = True
End Function
Public Sub DeleteToEnd()
Attribute DeleteToEnd.VB_Description = "刪除從當前位置到結尾的所有內容"
mysel.EndKey Unit:=wdStory, Extend:=wdExtend
mysel.Delete Unit:=wdCharacter, Count:=1
End Sub
Public Sub MoveEnd()
Attribute MoveEnd.VB_Description = "游標移動到文檔結尾"
'游標移動到文檔結尾
mysel.EndKey Unit:=wdStory
End Sub
Public Sub GotoLine(LineTime As Integer)
mysel.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=LineTime, Name:=""
End Sub
Public Sub OpenDoc(view As Boolean)
Attribute OpenDoc.VB_Description = "打開Word文件,View確定是否顯示Word界面"
On Error Resume Next
'********************************************************************************
' 打開Word文件，並給全局變數mysel賦值
'********************************************************************************
If Len(C_TemplateDoc) = 0 Then
mywdapp.Documents.Add
Else
mywdapp.Documents.Open (C_TemplateDoc)
End If
If Err.Number <> 0 Then
C_ErrMsg = 4
RaiseEvent HaveError
Exit Sub
End If
mywdapp.Visible = view
mywdapp.Activate
Set mysel = mywdapp.Application.Selection
'mysel.Select
End Sub
Public Sub OpenWord()
On Error Resume Next
'********************************************************************************
' 打開Word程序，並給全局變數mywdapp賦值
'********************************************************************************
Set mywdapp = CreateObject("word.application")
If Err.Number <> 0 Then
C_ErrMsg = 1
RaiseEvent HaveError
Exit Sub
End If
End Sub
Public Sub ViewDoc()
Attribute ViewDoc.VB_Description = "顯示Word程序界面"
mywdapp.Visible = True
End Sub
Public Sub AddNewPage()
Attribute AddNewPage.VB_Description = "插入分頁符"
mysel.InsertBreak Type:=wdPageBreak
End Sub
Public Sub WordCut()
Attribute WordCut.VB_Description = "剪切模板所有內容到剪切板"
'保存模板頁面內容
mysel.WholeStory
mysel.Cut
mysel.HomeKey Unit:=wdStory
End Sub
Public Sub WordCopy()
Attribute WordCopy.VB_Description = "拷貝模板所有內容到剪切板"
mysel.WholeStory
mysel.Copy
mysel.HomeKey Unit:=wdStory
End Sub
Public Sub WordDel()
mysel.WholeStory
mysel.Delete
mysel.HomeKey Unit:=wdStory
End Sub
Public Sub WordPaste()
Attribute WordPaste.VB_Description = "拷貝剪切板內容到當前位置"
'插入模塊內容
mysel.Paste
End Sub
Public Sub CloseDoc()
Attribute CloseDoc.VB_Description = "關閉Word文件模板"
'********************************************************************************
' 關閉Word文件模本
'********************************************************************************
On Error Resume Next
mywdapp.ActiveDocument.Close False
If Err.Number <> 0 Then
C_ErrMsg = 3
Exit Sub
End If
End Sub
Public Sub QuitWord()
'********************************************************************************
' 關閉Word程序
'********************************************************************************
On Error Resume Next
mywdapp.Quit
If Err.Number <> 0 Then
C_ErrMsg = 3
Exit Sub
End If
End Sub
Public Sub SavetoDoc()
Attribute SavetoDoc.VB_Description = "保存當前文檔為FileName指定文件"
On Error Resume Next
'並另存為文件FileName
If Len(C_newDoc) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Sub
End If
mywdapp.ActiveDocument.SaveAs (C_newDoc)
If Err.Number <> 0 Then
C_ErrMsg = 3
RaiseEvent HaveError
Exit Sub
End If
End Sub
Public Property Get TemplateDoc() As String
Attribute TemplateDoc.VB_Description = "模板文件名."
TemplateDoc = C_TemplateDoc
End Property
Public Property Let TemplateDoc(ByVal vNewValue As String)
C_TemplateDoc = vNewValue
End Property
Public Property Get newdoc() As String
Attribute newdoc.VB_Description = "執行CloseDoc方法時，將模板文件另存為此文件名指定的新文件.如果不指定，在執行CloseDoc方法時，將產生一個錯誤"
newdoc = C_newDoc
End Property
Public Property Let newdoc(ByVal vNewValue As String)
C_newDoc = vNewValue
End Property
Public Property Get PicFile() As String
Attribute PicFile.VB_Description = "圖像文件名"
PicFile = C_PicFile
End Property
Public Property Let PicFile(ByVal vNewValue As String)
C_PicFile = vNewValue
End Property
Public Property Get ErrMsg() As Integer
Attribute ErrMsg.VB_Description = "錯誤信息.ErrMsg代碼: 1-word沒有安裝 2-缺少參數 3-沒許可權寫文件 4-文件不存在"
ErrMsg = C_ErrMsg
End Property
④ vb.net 如何在word文檔的指定位置插入圖片
會用VBA嗎，先在word裡面插入圖片錄制宏，然後將錄制的VBA代碼修改成.net代碼就可以了
⑤ VB 如何控制WORD中插入圖片的大小等屬性
自己錄個宏，稍加改動就可以了。
Sub 圖片旋轉270度對齊頁面()
'圖片排版270度
If Selection.InlineShapes.Count = 0 Then
If Selection.ShapeRange.Count <> 0 Then
Selection.ShapeRange.Fill.Visible = msoFalse
'Selection.ShapeRange.AlternativeText = "Higer標書工具修改"
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Rotation = 270#
Selection.ShapeRange.Width = CentimetersToPoints(28.9)
Selection.ShapeRange.Height = CentimetersToPoints(20.2)
'Selection.ShapeRange.PictureFormat.Brightness = 0.5
'Selection.ShapeRange.PictureFormat.Contrast = 0.5
'Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
'Selection.ShapeRange.Left = 90.1
'Selection.ShapeRange.Top = 88.15
'Selection.ShapeRange.Left = -120.45
'Selection.ShapeRange.Top = 109.1
Selection.ShapeRange.RelativeHorizontalPosition = _
Selection.ShapeRange.RelativeVerticalPosition = _
Selection.ShapeRange.Left = wdShapeCenter
Selection.ShapeRange.Top = wdShapeCenter
Selection.ShapeRange.LockAnchor = False
Selection.ShapeRange.LayoutInCell = True
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.ZOrder 4
Selection.ShapeRange.ZOrder msoSendBackward
End If
End If
If Selection <> "" Then
If Selection.InlineShapes.Count <> 0 Then
'Selection.InlineShapes(1).Fill.Visible = msoFalse
'Selection.InlineShapes(1).Fill.Solid
'Selection.InlineShapes(1).Fill.Transparency = 0#
'Selection.InlineShapes(1).Line.Weight = 0.75
'Selection.InlineShapes(1).Line.Transparency = 0#
'Selection.InlineShapes(1).Line.Visible = msoFalse
'Selection.InlineShapes(1).LockAspectRatio = msoFalse
'Selection.InlineShapes(1).Width = CentimetersToPoints(28.9)
'Selection.InlineShapes(1).Height = CentimetersToPoints(20.2)
'Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
'Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
'Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
'Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
'Selection.InlineShapes(1).PictureFormat.CropRight = 0#
'Selection.InlineShapes(1).PictureFormat.CropTop = 0#
'Selection.InlineShapes(1).PictureFormat.CropBottom = 0#
Selection.InlineShapes(1).ConvertToShape '屬性轉換（InlineShapes(1)轉換為ShapeRange）
Selection.ShapeRange.Fill.Visible = msoFalse
'Selection.ShapeRange.AlternativeText = "Higer標書工具修改"
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Width = CentimetersToPoints(28.9)
Selection.ShapeRange.Height = CentimetersToPoints(20.2)
Selection.ShapeRange.Rotation = 270#
'Selection.ShapeRange.PictureFormat.Brightness = 0.5
'Selection.ShapeRange.PictureFormat.Contrast = 0.5
'Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
Selection.ShapeRange.RelativeHorizontalPosition = _
Selection.ShapeRange.RelativeVerticalPosition = _
Selection.ShapeRange.Left = wdShapeCenter
Selection.ShapeRange.Top = wdShapeCenter
Selection.ShapeRange.LockAnchor = False
Selection.ShapeRange.LayoutInCell = True
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.ZOrder 4
Selection.ShapeRange.ZOrder msoSendBackward
End If
End If
End Sub
⑥ 怎樣通過VB程序把圖片插入到用OPEN打開的WORD文件中
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim MyFileName As String = "xtreme.bmp"
Dim MyImage As Image = Image.FromFile(MyFileName)
Dim MyLeft As Object = 10
Dim MyTop As Object = 50
Dim MyWidth As Object = MyImage.Width
Dim MyHeight As Object = MyImage.Height
Me.Shapes.AddPicture(MyFileName, System.Reflection.Missing.Value, _
System.Reflection.Missing.Value, MyLeft, MyTop, MyWidth, _
MyHeight, System.Reflection.Missing.Value)
End Sub
⑦ 怎樣用VB打開word文件，並插入一個圖片到該word文件
遲了一步，但不過還是貼點東西過來，要不然剛才花那麼多時間白研究了
先在工程引用microsoft word
Option Explicit
Dim WithEvents WordApp As Word.Application
Dim WithEvents WordDoc As Word.Document
Private Sub Command1_Click()
Set WordApp = New Word.Application
WordApp.Visible = True
WordApp.Documents.Add
WordApp.ActiveDocument.Shapes.AddPicture "C:\WINNT\CIBA1B.bmp"
如果要保存成你定下的名字就用WordApp.ActiveDocument.Saveas……
⑧ 如何在VB中建立word文檔，並寫入文字和圖片
首先說明，你這樣是寫TXT，不是DOC，雖然Word可以打開，但根本就不是Word文件。當然不能存儲圖片了。請參考我以下的代碼。建一個Command1。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim ap As Word.Application, doc As Document
Private Sub Form_Load() '這個過程不必做修改，是建立一個新的Word文檔
Set ap = CreateObject("word.application")
ap.Visible = True
Set doc = ap.Documents.Add
End Sub
Private Sub Command1_Click()
doc.Content.InsertAfter Text:="請輸入你要輸入的內容" '插入文字，請使用這種格式
doc.Shapes.AddPicture FileName:="D:\a.jpg" '插入圖片，請使用這種格式，路徑自己寫
End Sub
其他問題再找我。