Xin giúp đỡ tạo macro VBA trong word (để xóa bỏ 1 từ lẻ trong 1 hàng)

Nơi trao đổi về VBA (Visual Basic for Application), lập trình cho ứng dụng Microsoft Office, AutoCAD...

Điều hành viên: tungblt

Đăng trả lời
hungth
Bài viết: 2
Ngày tham gia: Thứ 2 26/04/2021 3:46 pm

Xin giúp đỡ tạo macro VBA trong word (để xóa bỏ 1 từ lẻ trong 1 hàng)

Gửi bài by hungth »

Xin chào các bạn, do đặc thù đánh máy, thỉnh thoảng mình hay gặp văn bản có 1 từ lẻ cuối đoạn ở trên 1 hàng, để như vậy thì không đẹp mắt. Nên mình muốc có 1 cái Macro bằng VBA để xử lý vấn đề này. Xem trên mạng thì đấy 1 đoạn sau, nhưng mình không rõ các câu lệnh trong VBA nên mong nhờ mọi người giúp đỡ. Xin chân thành và cảm ơn.
đoạn mã mình tìm được trên google như sau:

1 Chuyển điểm nháy đến cuối tài liệu
2. Chuyển điểm nháy đến đầu đoạn văn ở trước
3. Nếu điểm nháy đã ở đầu tài liệu thì chuyển đến bước 9
4. Chuyển điểm nháy sang trái (để nó đến cuối dòng trước)
5. Chọn từ điểm nháy về đầu dòng, nhớ vô biến bb. Nếu trim(bb) = "" thì chuyển đến bước 8
6. Tìm dấu cách trong bb
7. Nếu không có (đây là chữ đứng lẻ trên dòng cuối): Chuyển điểm nháy sang trái, xóa lùi (1 gõ), thêm dấu cách không tách rời (hình như có ASCII = 160)
8. Chuyển đến bước 2
9. Kết thúc.
-------------------
Nếu có thể thì thay vì thay space bằng khoảng cách không tách rời ASCII=160; bằng phương pháp co giãn khoảng cách của cả đoạn để kéo chữ lên được không.
hungth
Bài viết: 2
Ngày tham gia: Thứ 2 26/04/2021 3:46 pm

Re: Xin giúp đỡ tạo macro VBA trong word (để xóa bỏ 1 từ lẻ trong 1 hàng)

Gửi bài by hungth »

Sau khi loay hoay tra google một số nơi, cũng làm tạm cái code này, mong mọi người đóng góp thêm

Sub XuLyTuLe()
Dim bb, bb1 As String
Dim ip, ik, itb As Integer
ik = 0
itb = 0
BG:
itb = itb + 1

Do
ik = ik + 1
Selection.MoveDown Unit:=wdParagraph, Count:=1 'xuong dau dong ben duoi
Selection.MoveLeft Unit:=wdCharacter, Count:=1 ' ve cuoi doan
'kiem tra xoa space o cuoi
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend ' chon 1 ky tu
bb = Selection.Text
If bb = " " Then
Selection.Delete Unit:=wdCharacter, Count:=1
End If
'-------------------
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend 'chon tu cuoi ve dau dong
bb = Selection.Text
bb = Trim(bb)
bb1 = Replace(bb, " ", "")
ip = Len(bb) - Len(bb1)
If ip = 0 Then
' có tu le
Selection.EndKey Unit:=wdLine ' ve cuoi dòng
Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend 'chon tu cuoi ve dau doan
Selection.Font.Spacing = Selection.Font.Spacing - 0.1 ' giam 0.1 pt
Else: Exit Do
End If
Loop Until ik = 10
ik = 0

Selection.EndKey Unit:=wdLine ' ve cuoi dòng

Selection.MoveDown Unit:=wdParagraph, Count:=2 'xuong dau doan thu 3
Selection.MoveLeft Unit:=wdCharacter, Count:=1 ' ve cuoi doan 2

Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend ' chon 3 ky tu
bb = Selection.Text
If bb = "./." Then
GoTo KT
Else
If itb = 50 Then
GoTo KT
End If

GoTo BG
End If
KT:
End Sub
Đăng trả lời

Quay về