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

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

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

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

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

نقل قول:

---

نوشته شده توسط mazoolagh

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

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

---

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

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

نقل قول:

---

نوشته شده توسط mazoolagh

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

---

بسیار عالی
نهایت تشکر را دارم و منتظر کدهای بی عیب و نقص شما مثل همیشه هستم

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

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

ضمیمه 151017

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

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

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

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

ضمیمه 151019

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

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 مثل همیشه عالی و مشکل گشا
بسیار از لطفتون ممنون
من به یه شکل دیگه از این نرم افزار استفاده خواهم کرد اگه مشکلی داشتم حتما مزاحمتون خواهم شد

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