Tách file word ra từng trang mỗi trang là 1 file (2 người xem)

[huuthang_bd]

Em đã download file test và làm như hướng dẫn để chia mỗi trang trong file word thành 1 file, nhưng khi thực hiện (Alt+F8) thì nó cứ báo lỗi : Fname = "File_" & VBA.Format(i, "000") & "_" & Mid(Selection.Text, 10, Len(Selection.Text) - 11) & ".doc"

Các bác giúp em làm sao để chia mỗi trang thành 1 file, mà tên mỗi file có tên nhân viên trong mỗi trang.

Thanks các bác nhiều !

Bạn thử Macro này thử xem. Sử dụng cho file nào cũng được, 1 trang được tách ra làm 1 file.

Sub TachFile()
Application.ScreenUpdating = False
Dim Doc As Document, Pages As Long
Set Doc = ActiveDocument
Selection.EndKey Unit:=wdStory
Selection.InsertBreak Type:=wdPageBreak
Selection.HomeKey Unit:=wdStory
Pages = Doc.BuiltInDocumentProperties(wdPropertyPages)
ChangeFileOpenDirectory ActiveDocument.Path
For i = 1 To Pages - 1
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
    Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
    Selection.Cut
    With Documents.Add
        Selection.Paste
        Selection.EndKey Unit:=wdStory
        Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        If AscW(Selection.Text) = 12 Or AscW(Selection.Text) = 13 Or AscW(Selection.Text) = 22 Then Selection.TypeBackspace
        .SaveAs Left(Doc.Name, InStrRev(Doc.Name, ".") - 1) & "_" & VBA.Format(i, "000") & ".doc", 0
        .Close
    End With
Next
Application.ScreenUpdating = True
End Sub

 

[SoiBien]

Tên của file duy nhất được saved là gì vậy bạn ?

 

[dothihoakokuyo]

Tên file duy nhất được tạo ra là : File_8_Nguyễn Văn Tưởng
Mình đã copy đoạn code trên của bạn và thực hiện thì ok rồi bạn ah, tuy nhiên bạn có cách nào tạo ra tên file chứa tên các nhân viên và file tạo ra giữ nguyên form đc ko?

Thanks bạn nhiều!

 

[SoiBien]

Tên file duy nhất được tạo ra là : File_8_Nguyễn Văn Tưởng
@soibien

Mình đã copy đoạn code trên của bạn và thực hiện thì ok rồi bạn ah, tuy nhiên bạn có cách nào tạo ra tên file chứa tên các nhân viên và file tạo ra giữ nguyên form đc ko?

@HuuThang_bd ???

Mình làm thấy bình thường mà !

đây là kết quả sau khi run macro SplitFile


Bạn down thử file này lại.

Các bác khác có ai chạy ra kết quả khác không? cho mình biết với !

 

[dothihoakokuyo]

Mình load file của bạn về rồi, run macro splitFile thì vẫn báo có 1 file tạo ra bạn ah. Mình gửi file đính kèm bạn xem giúp mình nhé.

Thanks ban!

 

[SoiBien]

hix, phức tạp nhỉ, debug mà hỏi qua hỏi lại trên forum thế này thì chịu.

 

[SoiBien]

chắc method Find có vấn đề, mình làm lại code này cho bạn toàn dùng Goto. Format file của bạn phải đúng như ví dụ nhé ( dòng STT ở dòng thử 2, dòng tên là thứ 3)

 

[dothihoakokuyo]

Được rồi anh ah, anh hướng dẫn giúp em em cách sửa code làm sao để khi mình muốn lấy tên file theo 1 dòng nào hoặc 1 nội dung nào trong văn bản để khi mình có văn khác thì có thể lấy tên file khác.

Cảm ơn anh nhiều nhé.

 

[nghongphuong88]

Mình thử cách này của bạn trên Word 2010 với file .docx thì bị cách dòng, mỗi trang tách ra thành một file nhưng lại là 2 trang vì bị thêm dòng trắng giữa các xuống dòng.

 

[ntn1197612]

-Cách trả lời này dễ khiến cho người giúp bạn phiền lòng.
-Theo mình, không có cách nào đơn giản hợn là phải dùng code.
-Mình đã lấy code của bác huuthang_bd làm giúp bạn, bạn mở file bấm vào nút chia file.
-Nếu chưa thấy hiệu quả thì vào Tools/Macro/Security/Security level - Chọn mức low/OK -Đóng file và mở lại- Bấm vào nút Chia file.
-Chạy ngon rồi nhớ cám ơn bác huuthang_bd.

File này mình mún sửa code thành tách 2 hoặc 3 trang thành 1 file thì sửa như thế nào vậy bạn?
Thú thật là đọc code ko hiểu cho lắm.

 

[SoiBien]

File này mình mún sửa code thành tách 2 hoặc 3 trang thành 1 file thì sửa như thế nào vậy bạn?
Thú thật là đọc code ko hiểu cho lắm.

Sub newSplitFile()
On Error Resume Next
Application.ScreenUpdating = False
Selection.EndKey Unit:=wdStory
Selection.InsertBreak Type:=wdPageBreak
Pages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
ChangeFileOpenDirectory ActiveDocument.Path
j = 0
For i = 0 To Pages – 1
[COLOR=#ff0000]‘ Pages là tổng số trang, vậy bạn đổi (pages -1) cho phù hợp[/COLOR]
    Selection.HomeKey Unit:=wdStory
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
[COLOR=#ff0000]'câu này chọn đến trang bạn muốn ngắt, => đổi Count cho phù hợp[/COLOR]
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    Selection.Cut
    Selection.TypeBackspace
    Selection.HomeKey Unit:=wdStory
    Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Stt = Mid(Selection.Text, InStr(1, Selection.Text, ": ") + 1, Len(Selection.Text))
   
    Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    tennv = Mid(Selection.Text, InStr(1, Selection.Text, ": ") + 1, Len(Selection.Text))
    Fname = "File_" & Stt & "_" & tennv & ".docx"
    If Fname <> "File__.docx" Then j = j + 1
    ActiveDocument.SaveAs2 FileName:=Fname, FileFormat:=wdFormatXMLDocument, LockComments:=False, _
         Password:="", AddToRecentFiles:=True, WritePassword:="", _
        ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, CompatibilityMode:=14
   
    Selection.WholeStory
    Selection.Paste
Next i
Application.ScreenUpdating = True
 
MsgBox "Done!" & Chr(13) & "There's " & j & " page(s) were saved !"
 
End Sub

bạn làm thử nhé,
for .. next ... khó hiểu thì dùng
Do While (ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) lớn hơn số pages muốn ngắt trang, nhớ kiểm tra số lẻ còn lại để bẫy lỗi không đú số trang để goto)
...
Loop

Thường mình tìm hiểu code bằng cách run từng dòng lệnh (nhấn F8) xem code nó làm gì, hiểu tổng quan của code rồi tìm đúng chỗ mình cần sửa, sửa lại, hì hì.

 

[dreams]

sao mềnh dùng không đc nhỉ.có phải cài thêm phần mềm hỗ trợ không đó

 

[võ quốc việt]

Bạn nào tách dùm mình file này ra từng trang nha. Cám ơn trước.
Võ Quốc Việt

 

[hoangdinhduat]

ACE có mã code tách 1 file thành các file nhỏ hơn, mỗi file từ 2 hoặc 3 trang (mình đang cần mỗi file 2 trang)
cho mình xin code hoàn chỉnh nhé, vì bị mù tịt về lập trình !

 

[hà yến]

loay hoay hoài mà ko dc, . dán code vào rùi làm thế nào nữa ah chỉ e với ah.

 

[Hai Lien]

Chào ACE! Làm sao để tách một File Word thành nhiều Flie nhỉ? tìm hiểu code hoài mà không hiểu gì hết luôn, có anh chị nào biết tách giùm em file này với! em cảm ơn nhiều ạ!!!!!!!!

 

[hoangvt160980]

Nho anh chay file nay giup minh voi

 

[blacknight87pt]

Hi các bác;
Mình muốn tách file word dựa vào đặc điểm là có ngắt trang ; và có filename là mid của dòng thứ n ( tức là gộp giữa 2 đoạn code của bác @soisbien + bác huuthang_db ạ. Mình chỉnh mãi k được gà code quá . Kính nhờ các bác giúp đỡ ạ
Thanks

 

[blacknight87pt]

Sau khi mày mò mình đã test thử có vẻ ổn; nhưng cảm giác hơi nặng và chưa được tối ưu... các bác tham khảo và chỉ dẫn thêm ạ

Option Explicit
Sub SlpipFile3()
Dim i As Long
Dim tennv
Dim Fname
Application.ScreenUpdating = False
ChangeFileOpenDirectory ActiveDocument.Path
'Selection.Find.ClearFormatting
With Selection.Find
.Text = "^k"
.Forward = True
.Wrap = wdFindContinue
End With


ActiveDocument.Range(0, 0).Select


Do Until Selection.Find.Execute = False
i = i + 1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdParagraph, Count:=999999999, Extend:=wdExtend
Selection.Cut
Selection.TypeBackspace




Selection.HomeKey Unit:=wdStory
Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
tennv = Mid(Selection.Text, InStr(1, Selection.Text, ": ") + 1, Len(Selection.Text))





Fname = "File_" & tennv & ".docx"
ActiveDocument.SaveAs2 FileName:=Fname, FileFormat:=wdFormatXMLDocument, LockComments:=False, _
Password:="", AddToRecentFiles:=True, WritePassword:="", _
ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, CompatibilityMode:=14

Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
ActiveDocument.Range(0, 0).Select
Loop


Application.Quit
Application.ScreenUpdating = True
End Sub

 

[netuser36]

Bạn thử dùng Macro này xem.

Sub SlpipFile()
Dim i As Long
Application.ScreenUpdating = False
ChangeFileOpenDirectory ActiveDocument.Path
Selection.Find.ClearFormatting
With Selection.Find
    .Text = "^k"
    .Forward = True
    .Wrap = wdFindContinue
End With
ActiveDocument.Range(0, 0).Select
Do Until Selection.Find.Execute = False
    i = i + 1
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdParagraph, Count:=999999999, Extend:=wdExtend
    Selection.Cut
    Selection.TypeBackspace
    ActiveDocument.SaveAs "File_" & VBA.Format(i, "000") & ".doc", 0
    ActiveDocument.Close
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.Paste
    ActiveDocument.Range(0, 0).Select
Loop
    ActiveDocument.SaveAs "File_" & VBA.Format(i + 1, "000") & ".doc", 0
Application.ScreenUpdating = True
End Sub

chào bạn code này tách được rồi, nhưng nó thêm 1 trang trắng sau tức 2 trang; muốn thay tên file bằng tên trong sách trộn có được không ạ? trộn thư với file danh sách excel có tên.
xin cảm ơn.