دنیای فناوری اطلاعات | ابوالفضل یوسفی راد
معلم | مدرس دانشگاه | نویسنده | داور فوتبال
دنیای فناوری اطلاعات | ابوالفضل یوسفی راد
معلم | مدرس دانشگاه | نویسنده | داور فوتبالآموزش ساخت تقدیرنامه انبوه با Mail Merge و VBA | خروجی جدا برای هر نفر
آموزش ساخت تقدیرنامه انبوه با Mail Merge و VBA | خروجی جدا برای هر نفر
در این ویدئو یاد میگیرید چطور با استفاده از قابلیت Mail Merge در Word و دادههای Excel، برای هر نفر بهصورت خودکار یک فایل ورد جداگانه (تقدیرنامه یا گواهینامه) بسازید.
این روش بدون نیاز به افزونه و فقط با چند خط کد VBA انجام میشود.
Sub SplitMailMergeToFiles()
Dim mainDoc As Document
Dim singleDoc As Document
Dim dataSrc As MailMergeDataSource
Dim i As Long
Dim savePath As String
Dim fileName As String
Dim fieldValue As String
' تنظیم مسیر ذخیره فایلها
savePath = "C:\Users\Public\Documents\" ' مسیر دلخواه خود را بگذارید
If Right(savePath, 1) "\" Then savePath = savePath "\"
Set mainDoc = ActiveDocument
Set dataSrc = mainDoc.MailMerge.DataSource
' حلقه روی همه رکوردها
For i = 1 To dataSrc.RecordCount
dataSrc.ActiveRecord = i
' استخراج مقدار از ستون خاص (مثلاً "Name")
On Error Resume Next
fieldValue = dataSrc.DataFields("name").Value ' ستون اکسل خودتان را اینجا بنویسید
If Err.Number 0 Then
fieldValue = "Record_" i
Err.Clear
End If
On Error GoTo 0
' اجرای Merge برای فقط رکورد فعال
mainDoc.MailMerge.Destination = wdSendToNewDocument
mainDoc.MailMerge.DataSource.FirstRecord = i
mainDoc.MailMerge.DataSource.LastRecord = i
mainDoc.MailMerge.Execute Pause:=False
' ذخیره فایل ایجاد شده
Set singleDoc = ActiveDocument
fileName = savePath "list_" fieldValue ".docx"
singleDoc.SaveAs2 fileName:=fileName, FileFormat:=wdFormatXMLDocument
singleDoc.Close SaveChanges:=False
Next i
MsgBox "تمام فایلها با موفقیت جداگانه ذخیره شدند!", vbInformation
End Sub
این روش بدون نیاز به افزونه و فقط با چند خط کد VBA انجام میشود.
Sub SplitMailMergeToFiles()
Dim mainDoc As Document
Dim singleDoc As Document
Dim dataSrc As MailMergeDataSource
Dim i As Long
Dim savePath As String
Dim fileName As String
Dim fieldValue As String
' تنظیم مسیر ذخیره فایلها
savePath = "C:\Users\Public\Documents\" ' مسیر دلخواه خود را بگذارید
If Right(savePath, 1) "\" Then savePath = savePath "\"
Set mainDoc = ActiveDocument
Set dataSrc = mainDoc.MailMerge.DataSource
' حلقه روی همه رکوردها
For i = 1 To dataSrc.RecordCount
dataSrc.ActiveRecord = i
' استخراج مقدار از ستون خاص (مثلاً "Name")
On Error Resume Next
fieldValue = dataSrc.DataFields("name").Value ' ستون اکسل خودتان را اینجا بنویسید
If Err.Number 0 Then
fieldValue = "Record_" i
Err.Clear
End If
On Error GoTo 0
' اجرای Merge برای فقط رکورد فعال
mainDoc.MailMerge.Destination = wdSendToNewDocument
mainDoc.MailMerge.DataSource.FirstRecord = i
mainDoc.MailMerge.DataSource.LastRecord = i
mainDoc.MailMerge.Execute Pause:=False
' ذخیره فایل ایجاد شده
Set singleDoc = ActiveDocument
fileName = savePath "list_" fieldValue ".docx"
singleDoc.SaveAs2 fileName:=fileName, FileFormat:=wdFormatXMLDocument
singleDoc.Close SaveChanges:=False
Next i
MsgBox "تمام فایلها با موفقیت جداگانه ذخیره شدند!", vbInformation
End Sub
این روش بدون نیاز به افزونه و فقط با چند خط کد VBA انجام میشود.
Sub SplitMailMergeToFiles()
Dim mainDoc As Document
Dim singleDoc As Document
Dim dataSrc As MailMergeDataSource
Dim i As Long
Dim savePath As String
Dim fileName As String
Dim fieldValue As String
' تنظیم مسیر ذخیره فایلها
savePath = "C:\Users\Public\Documents\" ' مسیر دلخواه خود را بگذارید
If Right(savePath, 1) "\" Then savePath = savePath "\"
Set mainDoc = ActiveDocument
Set dataSrc = mainDoc.MailMerge.DataSource
' حلقه روی همه رکوردها
For i = 1 To dataSrc.RecordCount
dataSrc.ActiveRecord = i
' استخراج مقدار از ستون خاص (مثلاً "Name")
On Error Resume Next
fieldValue = dataSrc.DataFields("name").Value ' ستون اکسل خودتان را اینجا بنویسید
If Err.Number 0 Then
fieldValue = "Record_" i
Err.Clear
End If
On Error GoTo 0
' اجرای Merge برای فقط رکورد فعال
mainDoc.MailMerge.Destination = wdSendToNewDocument
MsgBox "تمام فایلها با موفقیت جداگانه ذخیره شدند!", vbInformation
mainDoc.MailMerge.DataSource.FirstRecord = i
mainDoc.MailMerge.Execute Pause:=False
mainDoc.MailMerge.DataSource.LastRecord = i
Set singleDoc = ActiveDocument
' ذخیره فایل ایجاد شده
fileName = savePath "list_" fieldValue ".docx"
singleDoc.SaveAs2 fileName:=fileName, FileFormat:=wdFormatXMLDocument
singleDoc.Close SaveChanges:=False
Next i
End Sub
مشاهده ویدئو : https://www.aparat.com/v/oitmcp7
دانلود کد برنامه : https://s34.picofile.com/file/8487966050/code.txt.html