با سلام
در مورد ادغام چند فایل ورد با همدیگر طوری که ترتیب بهم نخورد (البته با VBA) اگه کسی اطلاعاتی داره ممنون میشم راهنمایی بفرمایید
با سلام
در مورد ادغام چند فایل ورد با همدیگر طوری که ترتیب بهم نخورد (البته با VBA) اگه کسی اطلاعاتی داره ممنون میشم راهنمایی بفرمایید
از دوستان و استادان عزیز کسی نیست به ما کمک کنه ؟؟؟
مشخص نکردین که با اکسس میخواین کار کنین یا خود word ؟
چون از هر دو میشه
اتفاقا با اکسس بهتر هست
ولی من برای هر دو نمونه میگذارم چون پرسش شما بار آموزشی داره
اول اینکه کار ساده ای هست و پیچیدگی خاصی نداره!
پس چرا پاسخ طولانی شد؟
چون بهتر دیدم که برنامه نمونه کاربردی باشه و نکات سودمند دیگری رو هم در بر داشته باشه
اول اضافه کردن رفرنس های مورد نیاز
0.PNG
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
آخرین ویرایش به وسیله mazoolagh : دوشنبه 04 آذر 1398 در 13:16 عصر
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 مثل همیشه عالی و مشکل گشا
بسیار از لطفتون ممنون
من به یه شکل دیگه از این نرم افزار استفاده خواهم کرد اگه مشکلی داشتم حتما مزاحمتون خواهم شد
موفق باشین آقا
اگر موردی بود که فکر کردین برای دیگران هم سودمند هست لطفا به اشتراک بگذارین