Code File Excel tìm kiếm và thay thế trong Word (1 người xem)

[viehoai]

Giả sử File word của em có tên là A.doc nội dung có các từ như sau "hoten" ; "ngaythang" ; "quequan"
File Excel của em có các nội dung tương ứng ở các cells A2, B2, C2
(hàng tiêu đề: A1="hoten"; B1: "ngaythang"; C1="quequan")
Xin các anh chị giuép đỡ code trong file Excel tìm kiếm trong File word các từ "hoten" ; "ngaythang" ; "quequan" và thay thế bằng các nội dung của các cells A2, B2, C2 tương ứng trong file excel
(Do một lý do khác em không dùng cách trộn văn bản trong word)
Xin cảm ơn các anh chị.

 

[ndu96081631]

Giả sử File word của em có tên là A.doc nội dung có các từ như sau "hoten" ; "ngaythang" ; "quequan"
File Excel của em có các nội dung tương ứng ở các cells A2, B2, C2
(hàng tiêu đề: A1="hoten"; B1: "ngaythang"; C1="quequan")
Xin các anh chị giuép đỡ code trong file Excel tìm kiếm trong File word các từ "hoten" ; "ngaythang" ; "quequan" và thay thế bằng các nội dung của các cells A2, B2, C2 tương ứng trong file excel
(Do một lý do khác em không dùng cách trộn văn bản trong word)
Xin cảm ơn các anh chị.

Sao bạn không đưa 2 file lên đây cho dễ hình dung nhỉ?
Tôi không dám chắc có thể làm được VBA trên Word, tuy nhiên ta có thể thí nghiệm bằng chức năng Record Macro

 

[viehoai]

Sao bạn không đưa 2 file lên đây cho dễ hình dung nhỉ?
Tôi không dám chắc có thể làm được VBA trên Word, tuy nhiên ta có thể thí nghiệm bằng chức năng Record Macro

Đây là File mẫu thôi không được đẹp xin sư phụ thông cảm
Xin giúp đỡ theo hướng:
1. Xem như 2 file này cùng thư mục
2. 2 file này đang mở
Xin cảm ơn

 

[viehoai]

Sao không ai giúp hết nhỉ ?

 

[ndu96081631]

Sao không ai giúp hết nhỉ ?

Dữ liệu của bạn khiến tôi lúng túng quá... Nó chẳng tổng quát gì cả! Giờ hỏi lại:
- Code nằm trong file Excel, đúng không?
- Dữ liệu trong file Excel có bao nhiêu dòng?
- Word chỉ có 1 file này thôi hay còn nhiều file khác nữa
---------------------
Bạn vui lòng cho dữ liệu tổng quát 1 chút ---> Chứ như 2 file của bạn, tôi không biết có nên dùng vòng lập không nữa

 

[viehoai]

Dữ liệu của bạn khiến tôi lúng túng quá... Nó chẳng tổng quát gì cả! Giờ hỏi lại:
- Code nằm trong file Excel, đúng không?
- Dữ liệu trong file Excel có bao nhiêu dòng?
- Word chỉ có 1 file này thôi hay còn nhiều file khác nữa
---------------------
Bạn vui lòng cho dữ liệu tổng quát 1 chút ---> Chứ như 2 file của bạn, tôi không biết có nên dùng vòng lập không nữa

Em xin nói rõ hơn là:
1. Code nằm trong file Excel
2. Dữ liệu trong file excel có nhiều dòng, nhưng em muốn thực hiện bất kỳ một dòng nào. Nếu được như thế tốt quá, còn không giúp em theo dòng thứ 2 vậy, em sẽ linh động tự nghiên cứu tiếp
3. Word chỉ một file này thôi (em sẽ đặt tên chuẩn) sau khi thực hiện người dùng sẽ tự save as còn save trực tiếp trên file này sẽ không được (cái này em nghĩ em sẽ làm được)
Xin sư phụ và các anh chị khác giúp đỡ. Em xin cảm ơn

 

[PhanTuHuong]

Anh Viethoi thử xem cái này và phát triển thêm nhé! Không hiểu vì sao lại lỗi font Unicode (tôi dùng Excel 2010), anh kiểm tra lại xem chữ "ê" copy sang có được không. Nhìn chung, nếu anh dùng Unicode là hạn chế, dễ thực hiện hơn nếu dùng TCVN.

 

[viehoai]

Anh Viethoi thử xem cái này và phát triển thêm nhé! Không hiểu vì sao lại lỗi font Unicode (tôi dùng Excel 2010), anh kiểm tra lại xem chữ "ê" copy sang có được không. Nhìn chung, nếu anh dùng Unicode là hạn chế, dễ thực hiện hơn nếu dùng TCVN.

Cảm ơn anh, nhưng trong code em muốn thực thi việc tìm kiểm và thay thế
Hoặc anh và các anh chị khác giúp đoạn code làm thế nào để code chạy ở Excel gọi một thủ tục trong word để làm việc đó (vì em nghĩ việc tìm kiếm và thay thế trong word em có thể record được)

 

[ndu96081631]

Cảm ơn anh, nhưng trong code em muốn thực thi việc tìm kiểm và thay thế
Hoặc anh và các anh chị khác giúp đoạn code làm thế nào để code chạy ở Excel gọi một thủ tục trong word để làm việc đó (vì em nghĩ việc tìm kiếm và thay thế trong word em có thể record được)

Hic... lúc đầu tưởng rất dễ, ai dè điều khiển Word từ Excel khó nhai thật ---> Mà thực ra code này cũng đâu phải khó viết, nhưng sao code cứ báo lỗi hoài nhỉ? (lại là lỗi nghiêm trọng, treo ứng dụng luôn)
Chà... chà...

 

[PhanTuHuong]

Cảm ơn anh, nhưng trong code em muốn thực thi việc tìm kiểm và thay thế
Hoặc anh và các anh chị khác giúp đoạn code làm thế nào để code chạy ở Excel gọi một thủ tục trong word để làm việc đó (vì em nghĩ việc tìm kiếm và thay thế trong word em có thể record được)

Không khó gì đâu, phải chịu khó phát triển code đó lên là được, nền tảng như code trong đó là OK!

 

[viehoai]

Không khó gì đâu, phải chịu khó phát triển code đó lên là được, nền tảng như code trong đó là OK!

Anh hướng dẫn giúp em đi. Trong điều khiển qua word em chẳng làm bao giờ

 

[ndu96081631]

Không khó gì đâu, phải chịu khó phát triển code đó lên là được, nền tảng như code trong đó là OK!

Nghĩ cũng lạ! Hôm qua tôi vẫn dùng code giống như thầy Hướng mà nó cứ báo lỗi hoài! Còn bây giờ thử lại thì ngon lành (chả hiểu ra làm sao ---> Có thể Office trục trặc gì đó chăng?)
Thật ra code để Find and Replace cũng khá đơn giản:

Sub Test()
  Dim wDoc
  On Error Resume Next
  With CreateObject("Word.Application")
    .Visible = True
    Set wDoc = .Documents.Open(ThisWorkbook.Path & "\Doc1.doc")  '<--- Đường dẫn đến file Word
    .Selection.Find.Execute "...chuổi tìm...", True, , , , , , , , "...chuổi thay thế...", 2
    wDoc.Close (True)
    .Quit
  End With
End Sub

Chỉ vậy thôi

 

[PhanTuHuong]

Lằng nhằng nhất vẫn là Unicode font, còn với TCVN thì đơn giản.

 

[viehoai]

Nghĩ cũng lạ! Hôm qua tôi vẫn dùng code giống như thầy Hướng mà nó cứ báo lỗi hoài! Còn bây giờ thử lại thì ngon lành (chả hiểu ra làm sao ---> Có thể Office trục trặc gì đó chăng?)
Thật ra code để Find and Replace cũng khá đơn giản:

Sub Test()
Dim wDoc
On Error Resume Next
With CreateObject("Word.Application")
.Visible = True
Set wDoc = .Documents.Open(ThisWorkbook.Path & "\Doc1.doc") '<--- Đường dẫn đến file Word
.Selection.Find.Execute "...chuổi tìm...", True, , , , , , , , "...chuổi thay thế...", 2
wDoc.Close (True)
.Quit
End With
End Sub

Chỉ vậy thôi

Cảm ơn Sư Phụ, code chạy tuyệt vời theo ý em. Xin hỏi thêm trong code khi thoát word không có câu lệnh save và nó cũng tự động save những thay đổi vì sao??

 

[ndu96081631]

Cảm ơn Sư Phụ, code chạy tuyệt vời theo ý em. Xin hỏi thêm trong code khi thoát word không có câu lệnh save và nó cũng tự động save những thay đổi vì sao??

wDoc.Close (True) ---> Đóng file wDoc đồng thời Save luôn đấy (Chữ True tương đương với Save và ngược lại)

 

[ducluongx3]

Bạn có thể giúp mình bài toán tổng quát hơn như sau:
1. Trong Excel: Cột A là cột giữ liệu cũ,
Cột B là cột giữ liệu mới để thay thế tương ứng với Cột B
Ô C1 là đường dẫn đến các file word cần sửa nội dung

2. Chạy chương trình là nó thực hiện sửa toàn bộ nội dung cho các file word theo nội dung trong excel.

 

[quocphu67]

Cảm ơn Sư Phụ, code chạy tuyệt vời theo ý em. Xin hỏi thêm trong code khi thoát word không có câu lệnh save và nó cũng tự động save những thay đổi vì sao??

Bác có thể viết lại code để em đọc hết nội dung tất cả các file trong thư mục được ko a?
em có nhiều file word cần thay thế 1 dòng chữ giống nhau... code của bác chỉ đọc được 1 file a.doc thôi.
em làm như thế này mà báo lỗi. em gà ko biết sửa ntn... em tự copy từ cái khác qua thôi

Sub Cord()Dim fPath As String, fName As String, wDoc
fPath = GetFolder(documents.Path)
fPath = fPath & ""
If fPath <> "" Then
fName = Dir(fPath & "*.docx")
On Error Resume Next
With CreateObject("Word.Application")
.Visible = True
Set wDoc = .documents.Open(fPath & fName) '<--- Ðu?ng d?n d?n file Word
.Selection.Find.Execute "nh,", True, , , , , , , , "Nam Giang", 2
End With
End Sub

Cho em hỏi thêm là đối với chuỗi ký tự là "tiếng việt có dấu thì nó làm như thế nào a.

 

[quocphu67]

Nghĩ cũng lạ! Hôm qua tôi vẫn dùng code giống như thầy Hướng mà nó cứ báo lỗi hoài! Còn bây giờ thử lại thì ngon lành (chả hiểu ra làm sao ---> Có thể Office trục trặc gì đó chăng?)
Thật ra code để Find and Replace cũng khá đơn giản:

Sub Test()
  Dim wDoc
  On Error Resume Next
  With CreateObject("Word.Application")
    .Visible = True
    Set wDoc = .Documents.Open(ThisWorkbook.Path & "\Doc1.doc")  '<--- Đường dẫn đến file Word
    .Selection.Find.Execute "...chuổi tìm...", True, , , , , , , , "...chuổi thay thế...", 2
    wDoc.Close (True)
    .Quit
  End With
End Sub

Chỉ vậy thôi

Bác có thể viết lại code để em đọc hết nội dung tất cả các file trong thư mục được ko a?
em có nhiều file word cần thay thế 1 dòng chữ giống nhau... code của bác chỉ đọc được 1 file a.doc thôi.
em làm như thế này mà báo lỗi. em gà ko biết sửa ntn... em tự copy từ cái khác qua thôi

Sub Cord()
Dim fPath As String, fName As String, wDoc
fPath = GetFolder(thisdocuments.Path)
fPath = fPath & ""
If fPath <> "" Then
fName = Dir(fPath & "*.docx")
On Error Resume Next
With CreateObject("Word.Application")
.Visible = True
Set wDoc = .documents.Open(fPath & fName) '<--- Ðu?ng d?n d?n file Word
.Selection.Find.Execute "nh,", True, , , , , , , , "Nam Giang", 2
End With
End If
End Sub


Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Cho em hỏi thêm là đối với chuỗi ký tự là "tiếng việt có dấu thì nó làm như thế nào a.

 

[hieuxd]

Nghĩ cũng lạ! Hôm qua tôi vẫn dùng code giống như thầy Hướng mà nó cứ báo lỗi hoài! Còn bây giờ thử lại thì ngon lành (chả hiểu ra làm sao ---> Có thể Office trục trặc gì đó chăng?)
Thật ra code để Find and Replace cũng khá đơn giản:

 Sub Test()
  Dim wDoc
  On Error Resume Next
  With CreateObject("Word.Application")
    .Visible = True
    Set wDoc = .Documents.Open(ThisWorkbook.Path & "\Doc1.doc")  '<--- Đường dẫn đến file Word
    .Selection.Find.Execute "...chuổi tìm...", True, , , , , , , , "...chuổi thay thế...", 2
    wDoc.Close (True)
    .Quit
  End With
End Sub

Chỉ vậy thôi

Thầy Ndu cho em hỏi Tiếp tục cái chủ đề này thầy nhé; Do chủ đề đã cũ nhưng chưa hoàn thiện thầy ạ.
Code của thầy em chạy rất ổn rồi nhưng em đang mắc ở cái chuỗi thay thế nó là ký tự 0 thì không chơi được thầy ạ
Các Thầy và mọi người giúp em xem lỗi đâu vậy mà bị vậy. Em gửi thư mục có 2 File mọi người giải nén kiểm tra giúp em nhé
Ý em muốn hỏi chỗ .Selection.Find.Execute "...chuổi tìm...", True, , , , , , , , "0", 2
Tại sao không được
Sub Test()
Dim wDoc
On Error Resume Next
With CreateObject("Word.Application")
.Visible = True
file = [C4]
Set wDoc = .Documents.Open(ThisWorkbook.Path & "" & file & ".doc") '<--- Ðu?ng d?n d?n file Word
For Each cls In Range([c7], [c65000].End(3))
If cls(1, 2) > 0 Then
.Selection.Find.Execute cls, , , , , , , , , Sheets("DaTa").Range(cls(1, 2).Address(0, 0)), 2
End If
Next
.Documents(ThisWorkbook.Path & "" & file & ".doc").SaveAs Filename:=ThisWorkbook.Path & "" & [d4] & ".doc"
wDoc.Close (True)
.Quit
End With
End Sub [/php]
https://drive.google.com/open?id=0B2DTHuUAF5fFdmRMbEFCSmtlVmM
Nâu không vào diễn đàn tải File lên không được. Em xin được gửi qua đường Link

 

[hieuxd]

Do tình thế hơi gấp em đã sử lý thêm một bước phụ để kịp In Quyết toán:
.Selection.Find.Execute "...chuổi tìm...", True, , , , , , , , "0~", 2
.Selection.Find.Execute "~", True, , , , , , , , "", 2
(Thêm bước trung gian xóa dấu ~)
Em đang vướng chỗ khi
Sheets("DaTa").Range(cls(1, 2).Address(0, 0))=0
Làm sao khai báo để
Sheets("DaTa").Range(cls(1, 2).Address(0, 0))="0"