Tách file word ra từng trang mỗi trang là 1 file

Liên hệ QC
dothihoakokuyo đã viết:
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 !
Nhấp chuột vào đây để mở rộng...
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.
Mã: 
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
 
Tên của file duy nhất được saved là gì vậy bạn ?
 
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!
 
dothihoakokuyo đã viết:
Tên file duy nhất được tạo ra là : File_8_Nguyễn Văn Tưởng
@soibien
Nhấp chuột vào đây để mở rộng...
dothihoakokuyo đã viết:
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 ???
Nhấp chuột vào đây để mở rộng...

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

đây là kết quả sau khi run macro SplitFile
ket qua.jpg

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 !
 

File đính kèm

  • Chia file.rar
    54.9 KB · Đọc: 210
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!
 

File đính kèm

  • ke qua.rar
    380.5 KB · Đọc: 37
hix, phức tạp nhỉ, debug mà hỏi qua hỏi lại trên forum thế này thì chịu.
 
Lần chỉnh sửa cuối:
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)
 

File đính kèm

  • Chia file.rar
    50.7 KB · Đọc: 165
Đượ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é.
 
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.
 
tintam7251 đã viết:
-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.
Nhấp chuột vào đây để mở rộng...


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. :)
 
ntn1197612 đã viết:
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. :)
Nhấp chuột vào đây để mở rộng...
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ì.
 
sao mềnh dùng không đc nhỉ.có phải cài thêm phần mềm hỗ trợ không đó
 
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
 

File đính kèm

  • tong hop LL May.docx
    622.9 KB · Đọc: 25
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 ! !$@!!
 
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.
 
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 ạ!!!!!!!!
 

File đính kèm

  • HOP DONG LAO DONG THOI VU 2015 - LUU.docx
    639.7 KB · Đọc: 5
Nho anh chay file nay giup minh voi
 

File đính kèm

  • chuan.doc
    711.5 KB · Đọc: 9
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 :)
 
Lần chỉnh sửa cuối:
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
 
huuthang_bd đã viết:
Bạn thử dùng Macro này xem.
PHP: 
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
Nhấp chuột vào đây để mở rộng...
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.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Mr.hieudoanxd
Khôi phục lại giao diện Excel về như cũ
Trả lời
19
Đọc
254
Mr.hieudoanxd
Mr.hieudoanxd
nguyenmauduyen
Giải bài tập hàm if
Trả lời
12
Đọc
190
VetMini
V
dungnd.vcu
Tìm đơn giá mới nhất trong danh sách sản phẩm
Trả lời
15
Đọc
176
VetMini
V
dunghtgiga
Chuyển dữ liệu từ nhiều hàng vào một hàng
Trả lời
4
Đọc
76
Duy Tùng 9x
Duy Tùng 9x
befaint
  • Question
[ Python và ứng dụng ] Lập trình thư viện cho VBA bằng Python
    • Thích
    • Yêu thích
3 4 5
Trả lời
92
Đọc
11K
BATHANH200286
B
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom