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

[ATA_TABRIZ]

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

[ATA_TABRIZ]

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

[mazoolagh]

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

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

[ATA_TABRIZ]

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

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

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

[mazoolagh]

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

[ATA_TABRIZ]

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

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

[mazoolagh]

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

[mazoolagh]

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

0.PNG

[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]

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