Sub ChangeSource()
Dim k As Long, filename As String, ext As String, fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.AllowMultiSelect = False
.Filters.Add "Excel files", "*.xlsx; *.xlsm; *.xlsb; *.xls", 1
If .Show = -1 Then filename = .SelectedItems(1)
End With
Set fd = Nothing
If filename = "" Then Exit Sub
For k = 1 To ThisDocument.Fields.Count
With ThisDocument.Fields(k).LinkFormat
If .Type = wdLinkTypeOLE Then
ext = LCase(Mid(.SourceFullName, InStrRev(.SourceFullName, ".") + 1, 3))
If ext = "xls" Then
.SourceFullName = filename
Else
.SourceFullName = filename & Mid(.SourceFullName, InStrRev(.SourceFullName, "!"))
End If
End If
End With
Next k
End Sub
Tức bên Excel bạn chọn 1 vùng -> Ctrl + C -> sang Word -> thẻ Home -> menu Paste -> PasteSpecial -> Paste link -> Microsoft Excel Worksheet Object?
Nếu không đúng thế thì ngừng đọc tiếp.
Tôi thấy tò mò nên thử nghiệm thôi. Được hay không thì cũng thôi. Tôi test 1 lần.
Lưu ý: Trước khi thử thì lưu lại tập tin Word gốc.
Mở tập tin Word -> ghi lại dưới dạng docm -> Alt + F11 -> đúp chuột vào ThisDocument -> menu Insert -> Module -> dán code sau vào Module1
Khi cần thiết thì chạy Sub ChangeSource -> duyệt tới và chọn tập tin Excel (xlsx, xlsm, xlsb, xls)
Mã:Sub ChangeSource() Dim k As Long, filename As String, ext As String, fd As FileDialog Set fd = Application.FileDialog(msoFileDialogOpen) With fd .AllowMultiSelect = False .Filters.Add "Excel files", "*.xlsx; *.xlsm; *.xlsb; *.xls", 1 If .Show = -1 Then filename = .SelectedItems(1) End With Set fd = Nothing If filename = "" Then Exit Sub For k = 1 To ThisDocument.Fields.Count With ThisDocument.Fields(k).LinkFormat If .Type = wdLinkTypeOLE Then ext = LCase(Mid(.SourceFullName, InStrRev(.SourceFullName, ".") + 1, 3)) If ext = "xls" Then .SourceFullName = filename Else .SourceFullName = filename & Mid(.SourceFullName, InStrRev(.SourceFullName, "!")) End If End If End With Next k End Sub
Chắc tôi bị ấm đầu, vì nhánh ELSE không bao giờ được thực hiện.Cám ơn anh batman1 rất nhiều à.
ext = LCase(Mid(.SourceFullName, InStrRev(.SourceFullName, ".") + 1, 3))
If ext = "xls" Then
.SourceFullName = filename
Else
.SourceFullName = filename & Mid(.SourceFullName, InStrRev(.SourceFullName, "!"))
End If
.SourceFullName = filename