Nhờ mọi người về VBA cho tăng số thứ tự các hình trong Word

nguyenphanna · 30/8/21

Chào các bạn, mình thường hay phải soạn bài, trong bài thường bổ sung các hình ảnh từ nhiều nguồn tài liệu. Do đó nên phải đánh số thứ tự lại các hình. Thông qua google, mình đã tổng hợp thành một macro tự tăng thứ tự hình, nhưng mà nó không nhận ra đâu là cuối cùng nên nó cứ lặp đi lặp lại. Nhờ mọi người xem giúp mình với ạ. Mình cảm ơn nhiều ạ
Sub Tangsothutuhinh()

Dim xFindStr As String
Dim xReplaceStr As String
Dim m As Integer
m = 0

xFindStr = InputBox("Find what:", "Tim", xFindStr)
xReplaceStr = InputBox("Replace with:", "Thay the", xReplaceStr)
CommandBars("Navigation").Visible = False
Do
m = m + 1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = xFindStr 'Find What
.Replacement.Text = xReplaceStr & m & ". " 'Replace With
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceOne

Loop Until Selection.Range.Bookmarks.Exists("\EndOfDoc") = True ' cho Ðê'n cuô'i document
MsgBox "Operation end, please view", vbInformation
End Sub

Mình xem thấy toàn không thấy điều kiện Loop ấy ạ. Loop Until Selection.Range.Bookmarks.Exists("\EndOfDoc") = True ' cho Ðê'n cuô'i document

giaiphap · 30/8/21

nguyenphanna đã viết:
Chào các bạn, mình thường hay phải soạn bài, trong bài thường bổ sung các hình ảnh từ nhiều nguồn tài liệu. Do đó nên phải đánh số thứ tự lại các hình. Thông qua google, mình đã tổng hợp thành một macro tự tăng thứ tự hình, nhưng mà nó không nhận ra đâu là cuối cùng nên nó cứ lặp đi lặp lại. Nhờ mọi người xem giúp mình với ạ. Mình cảm ơn nhiều ạ
Sub Tangsothutuhinh()

Dim xFindStr As String
Dim xReplaceStr As String
Dim m As Integer
m = 0

xFindStr = InputBox("Find what:", "Tim", xFindStr)
xReplaceStr = InputBox("Replace with:", "Thay the", xReplaceStr)
CommandBars("Navigation").Visible = False
Do
m = m + 1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = xFindStr 'Find What
.Replacement.Text = xReplaceStr & m & ". " 'Replace With
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceOne

Loop Until Selection.Range.Bookmarks.Exists("\EndOfDoc") = True ' cho Ðê'n cuô'i document
MsgBox "Operation end, please view", vbInformation
End Sub

Mình xem thấy toàn không thấy điều kiện Loop ấy ạ. Loop Until Selection.Range.Bookmarks.Exists("\EndOfDoc") = True ' cho Ðê'n cuô'i document

Tốt nhất là có tệp tin word mới biết trong đó có cái Bookmark nào không cái đã..

batman1 · 30/8/21

Nếu là tôi thì điều kiện là CHO TỚI KHI CÒN TÌM THẤY thì thực hiện vòng Do. Tức dùng WHILE. CÒN TÌM THẤY tức Execute còn trả về TRUE. Sẽ có lúc đã thay thế tất cả và KHÔNG CÒN TÌM THẤY, lúc đó Execute trả về False, điều kiện không còn thỏa nên vòng Do kết thúc.

Mã:

Sub Tangsothutuhinh()

Dim xFindStr As String
Dim xReplaceStr As String
Dim m As Integer

    xFindStr = InputBox("Find what:", "Tim", xFindStr)
    If xFindStr = "" Then Exit Sub
    xReplaceStr = InputBox("Replace with:", "Thay the", xReplaceStr)
    m = 1
    
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = xFindStr 
        .Forward = True
        .Wrap = wdFindContinue
        Do While .Execute(replacewith:=xReplaceStr & m & ". ")
            m = m + 1
        Loop
    End With
    MsgBox "Operation end, please view", vbInformation
End Sub

Lần sau hãy đính kèm tập tin

nguyenphanna · 31/8/21

batman1 đã viết:
Nếu là tôi thì điều kiện là CHO TỚI KHI CÒN TÌM THẤY thì thực hiện vòng Do. Tức dùng WHILE. CÒN TÌM THẤY tức Execute còn trả về TRUE. Sẽ có lúc đã thay thế tất cả và KHÔNG CÒN TÌM THẤY, lúc đó Execute trả về False, điều kiện không còn thỏa nên vòng Do kết thúc.

Mã:

Sub Tangsothutuhinh() Dim xFindStr As String Dim xReplaceStr As String Dim m As Integer xFindStr = InputBox("Find what:", "Tim", xFindStr) If xFindStr = "" Then Exit Sub xReplaceStr = InputBox("Replace with:", "Thay the", xReplaceStr) m = 1 With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = xFindStr .Forward = True .Wrap = wdFindContinue Do While .Execute(replacewith:=xReplaceStr & m & ". ") m = m + 1 Loop End With MsgBox "Operation end, please view", vbInformation End Sub

Lần sau hãy đính kèm tập tin

Cảm ơn bạn đã giúp mình, nhưng nếu dùng điều kiện này thì nó không ổn lắm bạn. Bởi vì mình dùng nhiều hình ảnh từ nhiều nguồn tài liệu nên lúc này để nhanh thì mình sẽ không tìm bằng số cụ thể mà dùng: ^pHình^#^#.^# để tìm và thay thế bằng: ^pHình 12. Như vậy điều kiện tìm là luôn có bạn ạ

tigertiger · 31/8/21

nguyenphanna đã viết:
Chào các bạn, mình thường hay phải soạn bài, trong bài thường bổ sung các hình ảnh từ nhiều nguồn tài liệu. Do đó nên phải đánh số thứ tự lại các hình. Thông qua google, mình đã tổng hợp thành một macro tự tăng thứ tự hình, nhưng mà nó không nhận ra đâu là cuối cùng nên nó cứ lặp đi lặp lại. Nhờ mọi người xem giúp mình với ạ. Mình cảm ơn nhiều ạ
Sub Tangsothutuhinh()

Dim xFindStr As String
Dim xReplaceStr As String
Dim m As Integer
m = 0

xFindStr = InputBox("Find what:", "Tim", xFindStr)
xReplaceStr = InputBox("Replace with:", "Thay the", xReplaceStr)
CommandBars("Navigation").Visible = False
Do
m = m + 1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = xFindStr 'Find What
.Replacement.Text = xReplaceStr & m & ". " 'Replace With
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceOne

Loop Until Selection.Range.Bookmarks.Exists("\EndOfDoc") = True ' cho Ðê'n cuô'i document
MsgBox "Operation end, please view", vbInformation
End Sub

Mình xem thấy toàn không thấy điều kiện Loop ấy ạ. Loop Until Selection.Range.Bookmarks.Exists("\EndOfDoc") = True ' cho Ðê'n cuô'i document

VBA cũng tốt
Nhưng tốt hơn thì không cần, dùng chính field figue numbering của Ms.WORD như sau

Liên kết: https://www.youtube.com/watch?v=iDJqk5aKH5U

nguyenphanna · 31/8/21

Cảm ơn bạn, mình sẽ tham khảo ạ
Tuy nhiên dùng VBA mình tùy biến được nhiều hơn bạn ạ

Bài đã được tự động gộp: 31/8/21

tigertiger đã viết:
VBA cũng tốt
Nhưng tốt hơn thì không cần, dùng chính field figue numbering của Ms.WORD như sau

Liên kết: https://www.youtube.com/watch?v=iDJqk5aKH5U

Cảm ơn bạn, mình sẽ tham khảo ạ
Tuy nhiên dùng VBA mình tùy biến được nhiều hơn bạn ạ

batman1 · 31/8/21

nguyenphanna đã viết:
Cảm ơn bạn đã giúp mình, nhưng nếu dùng điều kiện này thì nó không ổn lắm bạn. Bởi vì mình dùng nhiều hình ảnh từ nhiều nguồn tài liệu nên lúc này để nhanh thì mình sẽ không tìm bằng số cụ thể mà dùng: ^pHình^#^#.^# để tìm và thay thế bằng: ^pHình 12. Như vậy điều kiện tìm là luôn có bạn ạ

Chưa cần bàn, liệu dạng pattern có chuẩn hay không, vd. không như bạn viết mà sau Hình phải có dấu cách, nếu không có dấu cách thì không tìm thấy vd. Hình 12.1. Do kết quả thay thế lại có dạng Find what nên vòng Do Loop sẽ làm việc mãi. Cách khắc phục có thể nhiều vd.:
- Replace with = ^pXXXXHình 12.
- Do Loop để thay thế.
- tiếp theo Find what = XXXX, Replace with = "". Execute với ReplaceAll

nguyenphanna · 31/8/21

batman1 đã viết:
Chưa cần bàn, liệu dạng pattern có chuẩn hay không, vd. không như bạn viết mà sau Hình phải có dấu cách, nếu không có dấu cách thì không tìm thấy vd. Hình 12.1. Do kết quả thay thế lại có dạng Find what nên vòng Do Loop sẽ làm việc mãi. Cách khắc phục có thể nhiều vd.:
- Replace with = ^pXXXXHình 12.
- Do Loop để thay thế.
- tiếp theo Find what = XXXX, Replace with = "". Execute với ReplaceAll

Đó là một cách thông minh đó ạ
Mình sẽ dùng cái này
Nhưng mình vẫn hy vọng bạn xem có cách nào để thoát vòng lặp khác nữa không ạ.
Bởi vì, khi thay đổi chương thì tên hình nó sẽ thay đổi sang là Hình 2.xx, nên nếu ta làm chương 1 xong, làm sang chương 2 thì nó lại chạy thay thế cả chương 1. Như thế thì mình phải làm lại từ đầu một lần

huuthang_bd · 31/8/21

Thớt thử code này xem.

Mã:

Sub Macro1()
    Dim i As Long
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .MatchWildcards = True
        .Text = "<H" & ChrW(236) & "nh *([!0-9.])"
        .Forward = True
        .Wrap = wdFindStop
        Do
            Selection.Collapse wdCollapseEnd
            i = i + 1
        Loop While .Execute(ReplaceWith:="H" & ChrW(236) & "nh " & i & "\1")
    End With
End Sub

nguyenphanna · 31/8/21

huuthang_bd đã viết:

Thớt thử code này xem.

Mã:

Sub Macro1()
    Dim i As Long
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .MatchWildcards = True
        .Text = "<H" & ChrW(236) & "nh *([!0-9.])"
        .Forward = True
        .Wrap = wdFindStop
        Do
            Selection.Collapse wdCollapseEnd
            i = i + 1
        Loop While .Execute(ReplaceWith:="H" & ChrW(236) & "nh " & i & "\1")
    End With
End Sub

Cảm ơn bạn, nhưng cái này không dùng được khi mình dùng ký tự ^# được. Ngoài ra còn ký tự ^p nữa, bởi tên hình khi nào cũng nằm đầu paragraph. Ngoài ra bạn chọn cho con trỏ về đầu sẽ bị dính lỗi như trên: lỗi khi muốn đổi theo chương

batman1 · 31/8/21

nguyenphanna đã viết:
Đó là một cách thông minh đó ạ
Mình sẽ dùng cái này
Nhưng mình vẫn hy vọng bạn xem có cách nào để thoát vòng lặp khác nữa không ạ.
Bởi vì, khi thay đổi chương thì tên hình nó sẽ thay đổi sang là Hình 2.xx, nên nếu ta làm chương 1 xong, làm sang chương 2 thì nó lại chạy thay thế cả chương 1. Như thế thì mình phải làm lại từ đầu một lần

Bạn hãy chạy lần lượt các chương. Sau cùng mới chạy 1 sub khác để đưa tất cả XXXX về RỖNG. Hoặc bước cuối này làm bằng tay ở cửa sổ Find and Replace.

nguyenphanna · 31/8/21

batman1 đã viết:
Bạn hãy chạy lần lượt các chương. Sau cùng mới chạy 1 sub khác để đưa tất cả XXXX về RỖNG. Hoặc bước cuối này làm bằng tay ở cửa sổ Find and Replace.

Nếu mà chạy là nó chạy hết tất cả đó bạn, chương 1 và chương 9 đều như nhau là ^# mà.
Nhưng mình vừa tìm ra phương pháp rồi. Đó là sử dụng thêm một biến là số trang con trỏ hiện tại và số trang của toàn document.
Cảm ơn tất cả mọi người ạ

Nhờ mọi người về VBA cho tăng số thứ tự các hình trong Word

nguyenphanna

Thành viên mới

giaiphap

==(^o^)==

batman1

Thành viên gạo cội

nguyenphanna

Thành viên mới

File đính kèm

tigertiger

Coming back ...

nguyenphanna

Thành viên mới

batman1

Thành viên gạo cội

nguyenphanna

Thành viên mới

huuthang_bd

Chuyên gia GPE

nguyenphanna

Thành viên mới

batman1

Thành viên gạo cội

nguyenphanna

Thành viên mới

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

Facebook

Group

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