ادغام چند فایل ورد

[ATA_TABRIZ]

با سلام
در مورد ادغام چند فایل ورد با همدیگر طوری که ترتیب بهم نخورد (البته با VBA) اگه کسی اطلاعاتی داره ممنون میشم راهنمایی بفرمایید

[ATA_TABRIZ]

از دوستان و استادان عزیز کسی نیست به ما کمک کنه ؟؟؟

[mazoolagh]

مشخص نکردین که با اکسس میخواین کار کنین یا خود word ؟

چون از هر دو میشه

[ATA_TABRIZ]

مشخص نکردین که با اکسس میخواین کار کنین یا خود word ؟

چون از هر دو میشه

جناب آقای Mazoolag ضمن تشکز از توجه شما اگه امکانش باشه با اکسس (VBA) خیلی عالی میشه

[mazoolagh]

اتفاقا با اکسس بهتر هست
ولی من برای هر دو نمونه میگذارم چون پرسش شما بار آموزشی داره

[ATA_TABRIZ]

اتفاقا با اکسس بهتر هست
ولی من برای هر دو نمونه میگذارم چون پرسش شما بار آموزشی داره
بسیار عالی
نهایت تشکر را دارم و منتظر کدهای بی عیب و نقص شما مثل همیشه هستم

[mazoolagh]

اول اینکه کار ساده ای هست و پیچیدگی خاصی نداره!
پس چرا پاسخ طولانی شد؟
چون بهتر دیدم که برنامه نمونه کاربردی باشه و نکات سودمند دیگری رو هم در بر داشته باشه

[mazoolagh]

اول اضافه کردن رفرنس های مورد نیاز

151017

[mazoolagh]

Option Compare Database
Option Explicit
Sub s1()
Dim WordApp As New Word.Application
Dim Doc As Word.Document
Set Doc = WordApp.Documents.Add
Dim Path As String
Path = CurrentProject.Path
Dim i As Integer
For i = 1 To 3
WordApp.Selection.InsertFile Path & "\problems" & i & ".docx"
Next i
Doc.SaveAs Path & "\Problems.docx"
Doc.Close
WordApp.Quit wdSaveChanges
End Sub

[mazoolagh]

کد بالا و فایلهای استفاده شده در دیتابیس پیوست هست و میتونین استفاده کنین

[mazoolagh]

در یک برنامه کاربردی :
1- کاربر باید بتونه فایلهای دلخواه رو انتخاب کنه
2- ترتیب اون ها تغییر بده
3- در صورت لزوم از لیست فایلها حذف کنه
4- نوع فایل رو انتخاب کنه
5- اسم فایل نهایی و فولدر اون رو تعیین کنه
6- در صورت لزوم عملیات رو کنسل کنه

در فرم طراحی شده این موارد دیده شده و با بررسی طراحی و کدها با روش کار آشنا میشین

151019

[mazoolagh]

Option Compare Database
Option Explicit
Dim v
Dim Canceled As Boolean
Dim InProgress As Boolean
Const DefaultFileName As String = "FinalResult"


Private Sub Form_Open(Cancel As Integer)
Me.FileName = DefaultFileName
Me.DestinationFolder = CurrentProject.Path
Me.BTN_CANCEL.Visible = False
InProgress = False
End Sub


Private Sub BTN_ADD_FILES_Click()
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFilePicker)
FD.InitialFileName = Me.DestinationFolder
FD.AllowMultiSelect = True
FD.InitialView = msoFileDialogViewList
FD.Filters.Clear
FD.Filters.Add "Word Document", "*.docx,*.doc"
FD.Filters.Add "PDF", "*.pdf"
FD.Filters.Add "html", "*.html"
FD.Show
Dim file
For Each file In FD.SelectedItems
Me.DocumentsList.AddItem file
Next
End Sub


Private Sub BTN_CLEAR_LIST_Click()
If InProgress Then Exit Sub
Dim i As Integer
Me.DocumentsList.RowSource = ""
End Sub


Private Sub BTN_MOVE_DOWN_Click()
If InProgress Then Exit Sub
Dim index As Integer
index = Me.DocumentsList.ListIndex
If index = Me.DocumentsList.ListCount - 1 Then Exit Sub
Me.DocumentsList.AddItem Me.DocumentsList.Value, index + 2
Me.DocumentsList.RemoveItem index
End Sub


Private Sub BTN_MOVE_UP_Click()
If InProgress Then Exit Sub
Dim index As Integer
index = Me.DocumentsList.ListIndex
If index < 1 Then Exit Sub
Me.DocumentsList.AddItem Me.DocumentsList.Value, index - 1
Me.DocumentsList.RemoveItem index + 1
End Sub


Private Sub BTN_REMOVE_Click()
If InProgress Then Exit Sub
Dim i As Integer
If Me.DocumentsList.ListIndex >= 0 Then
Me.DocumentsList.RemoveItem Me.DocumentsList.ListIndex
End If
End Sub


Private Sub BTN_SELECT_DESTINATION_FOLDER_Click()
If InProgress Then Exit Sub
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
FD.InitialFileName = Me.DestinationFolder
FD.Title = "Select Destination Folder"
FD.InitialView = msoFileDialogViewList
FD.Show
If FD.SelectedItems.Count > 0 Then
Me.DestinationFolder = FD.SelectedItems(1)
End If
Set FD = Nothing
End Sub

[mazoolagh]

Private Sub BTN_APPEND_Click()
On Error GoTo Error_Handler
Dim i, n As Integer
n = Me.DocumentsList.ListCount
If n = 0 Then
v = MsgBox("Select Documents", vbExclamation, "")
Exit Sub
End If
InProgress = True
Canceled = False
Me.BTN_CANCEL.Visible = True
Dim WordApp As New Word.Application
Dim Doc As Word.Document
Set Doc = WordApp.Documents.Add
Dim file
v = SysCmd(acSysCmdClearStatus)
For i = 1 To n
file = Me.DocumentsList.ItemData(i - 1)
v = SysCmd(acSysCmdSetStatus, "Adding " & i & " of " & n & " : " & file)
DoEvents
If Canceled Then
If MsgBox("Cancel Operation?", vbQuestion + vbYesNo, "") = vbYes Then
v = SysCmd(acSysCmdClearStatus)
Me.BTN_ADD_FILES.SetFocus
Me.BTN_CANCEL.Visible = False
Exit Sub
Else
Canceled = False
End If
End If
WordApp.Selection.InsertFile file
Next i
v = SysCmd(acSysCmdSetStatus, "Saving File ...")
Doc.SaveAs Me.DestinationFolder & "" & Me.FileName & ".docx"
Doc.Close
WordApp.Quit wdSaveChanges
Me.BTN_ADD_FILES.SetFocus
Me.BTN_CANCEL.Visible = False
v = SysCmd(acSysCmdClearStatus)
v = MsgBox("Document saved successfully," & vbCrLf & "Do you want to open it?", vbYesNo + vbInformation, "")
If v = vbYes Then
Application.FollowHyperlink Me.DestinationFolder & "" & Me.FileName & ".docx"
End If
Exit Sub
Error_Handler:
v = SysCmd(acSysCmdClearStatus)
v = MsgBox(Err.Description, vbCritical, "Error " & Err.Number)
Me.BTN_ADD_FILES.SetFocus
Me.BTN_CANCEL.Visible = False
End Sub


Private Sub BTN_CANCEL_Click()
Canceled = True
End Sub

[mazoolagh]

برنامه و فایلهای نمونه

[ATA_TABRIZ]

جناب Mazoolagh مثل همیشه عالی و مشکل گشا
بسیار از لطفتون ممنون
من به یه شکل دیگه از این نرم افزار استفاده خواهم کرد اگه مشکلی داشتم حتما مزاحمتون خواهم شد

[mazoolagh]

موفق باشین آقا
اگر موردی بود که فکر کردین برای دیگران هم سودمند هست لطفا به اشتراک بگذارین