Private Sub CommandButton7_Click()
On Error GoTo ErrHandler
Dim wd As Word.Application
Dim wdDoc As Word.Document
Dim wrdPic As Word.InlineShape
Dim ImgName As String
Dim xlSht As Worksheet
Dim MyConn As String
Dim rst As ADODB.Recordset
Dim i As Integer, intRec As Integer
Dim arrVal As Variant
MyConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source= " & ThisWorkbook.Path & "\VT.mdb"
Set rst = New ADODB.Recordset
rst.Open "personel", MyConn, adOpenStatic, adLockReadOnly
intRec = rst.RecordCount
arrVal = rst.GetRows(intRec)
On Error Resume Next
Set wd = New Word.Application
With wd
.Visible = False
.ScreenUpdating = False
End With
For i = 0 To (intRec - 1)
ImgName = ThisWorkbook.Path & "\Resimler\" & arrVal(1, i) & ".jpg"
Set wdDoc = wd.Documents.Add(ThisWorkbook.Path & "\sablon.dotx")
With wdDoc
.Bookmarks("ad").Range.Text = arrVal(4, i)
.Bookmarks("anneadi").Range.Text = arrVal(51, i)
.Bookmarks("sicil").Range.Text = arrVal(1, i)
If Dir(ImgName) <> "" Then
Set wrdPic = .Bookmarks("Img").Range.InlineShapes.AddPicture(Filename:=ImgName, LinkToFile:=False, SaveWithDocument:=True)
wrdPic.Height = 95
wrdPic.Width = 110
End If
.SaveAs2 Filename:=ThisWorkbook.Path & "\" & arrVal(4, i) & ".docx", FileFormat:=wdFormatXMLDocument
.Close
End With
Next i
With wd
.ScreenUpdating = True
.Quit
End With
ErrExit:
Set wd = Nothing
Set wdDoc = Nothing
Exit Sub
ErrHandler:
wd.Quit
Set wd = Nothing
Set wdDoc = Nothing
Set wrdPic = Nothing
End Sub
