• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Trao đổi về Word VBA Mời vào đây!

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

vinhthichip
Bài viết: 1
Ngày tham gia: T.Tư 23/11/2016 4:33 pm

Chia nhỏ file .pdf

Gửi bàigửi bởi vinhthichip » T.Tư 11/01/2017 1:20 pm

Tôi có 1 thư .pdf gồm nhiều khách hàng. Giờ muốn chia mỗi trang là 1 khách hàng, tên file là mã khách hàng. Sư phụ nào giúp mình với, cảm ơn nhiều.
nnthi.gla@gmail.com
ĐT: 0977990900



dzung
Bài viết: 1
Ngày tham gia: T.Hai 19/11/2012 7:40 am

Re: Trao đổi về Word VBA Mời vào đây!

Gửi bàigửi bởi dzung » T.Sáu 17/03/2017 7:05 am

anh TruongPhu ơi cho xin lại code , trong bài cũ viewtopic.php?t=21600#p119000
cái Userform như hình không thấy . Thanks

chinh2308
Bài viết: 1
Ngày tham gia: T.Bảy 01/04/2017 3:40 pm

Re: Trao đổi về Word VBA Mời vào đây!

Gửi bàigửi bởi chinh2308 » T.Bảy 01/04/2017 3:53 pm

Chào a phú.
Em có một vấn đề xin được a giúp đỡ.
Đang có 1 file câu hỏi như sau:
Phần hỏi:
Câu 1. abcxyz
Câu 2. abkh
Câu 3. dfdfsd

Phần trả lời:
Câu 1. kjlk
Câu 2. jlkj
Câu 3. ịojo

Em muốn ghép các câu trả lời vào từng câu hỏi như là:
Câu 1. abcxyz
trả lời: kjlk
Câu 2. abkh
trả lời: jkkj
...
Mong được a giúp đỡ. Cảm ơn anh nhiều
file mẫu đính kèm.
Tập tin đính kèm
ghep.rar
(34.26 KiB) Đã tải 66 lần

thuonghieuso
Bài viết: 4
Ngày tham gia: T.Bảy 12/11/2016 3:19 pm

Re: Trao đổi về Word VBA Mời vào đây!

Gửi bàigửi bởi thuonghieuso » T.Hai 22/05/2017 4:47 pm

Chào Bác Phú.
Em cần giúp đỡ.
Em có 1 đoạn như thế này.
Câu hỏi: Bầu trời kia thật xanh biếc. Nhìn lên đó có biết bao là ........?
a. Mây
b. Trăng
c. Sao
d. Mặt trời.
Em muốn Tìm và thay thế ("C.") . Nhưng lúc tìm và thay thế thì nó thay thế cả 2 chỗ . Chữ biếc. và C. Sao. Làm sao để phân biệt được 2 chỗ trên. E chỉ muốn thay thế bên dưới.
Mong bác giúp đỡ.

nhu2017
Bài viết: 1
Ngày tham gia: T.Ba 18/07/2017 12:40 pm

Re: Trao đổi về Word VBA Mời vào đây!

Gửi bàigửi bởi nhu2017 » T.Năm 20/07/2017 9:57 pm

bác truongphu có tài liệu về VBA word bằng tiếng việt không? cho tiện anh em nghiên cứu

awakealove
Bài viết: 6
Ngày tham gia: T.Ba 10/01/2012 7:44 pm
Has thanked: 1 time

MailMerge Trong Word VBA code Xin Giúp đỡ

Gửi bàigửi bởi awakealove » T.Năm 19/10/2017 8:49 pm

Em có:
- File word tên MMerge.doc
- File excel tên Source.xls
Yêu cầu:
1. Khi mở file MMerge.doc lên thì tự động set DataSource cho File word từ file excel Source.xls (Sheet1) để dùng trộn thư
2. Trên file word MMerge.doc có 1 nút lệnh tên CmdExp, khi click nút này thì sẽ tự động lưu ra file word mới theo Record hiện tại
(Merge to New Document). Chỉ cần trích mẫu tin hiện tại không phải trích toàn bộ.

Xin mọi người giúp đỡ!

vongcohay
Bài viết: 4
Ngày tham gia: T.Ba 14/02/2017 7:25 am
Has thanked: 3 time
Been thanked: 1 time

Re: Trao đổi về Word VBA Mời vào đây!

Gửi bàigửi bởi vongcohay » T.Ba 13/03/2018 9:59 am

anh em cho mình hỏi, trong word muốn tìm chữ màu xanh gạch chân (single) thay thế bằng màu đỏ thì làm sao? cám ơn

loannguyen14141993
Bài viết: 2
Ngày tham gia: T.Hai 19/03/2018 10:14 am

Re: Trao đổi về Word VBA Mời vào đây!

Gửi bàigửi bởi loannguyen14141993 » T.Hai 19/03/2018 10:25 am

giúp e bài này với ạ

stt m n tổng từ m đến n dùng hàm Vba để tính tổng m đến n biết m<n.(sumMToN)
1 1 10 biết rằng m,n as integer, kiểu trả về sumMToN cũng là integer
2 2 15
3 3 18
4 5 21
5 6 25
6 7 30
7 8 37
8 9 40
9 10 45

loannguyen14141993
Bài viết: 2
Ngày tham gia: T.Hai 19/03/2018 10:14 am

Re: Trao đổi về Word VBA Mời vào đây!

Gửi bàigửi bởi loannguyen14141993 » T.Hai 19/03/2018 10:34 am

và bài này nữa ạ
TT NGÀY TÊN TRƯỜNG DÂN TỘC ĐIỂM ƯU TIÊN
01 01/01/2003 NGUYỄN THỊ NHUNG ĐH Nông lâm Kinh
02 03/01/2003 NGUYỄN TẤN HÙNG ĐH Bách Khoa Nùng
03 05/01/2003 VÕ THỊ LÝ ĐH sư phạm Kinh
04 18/01/2003 HuỲNH VĂN MẪN ĐH Nông lâm Ê Đê
05 25/01/2003 LÂM KHỞI ĐH Bách Khoa H' Mông
06 04/02/2003 NGUYỄN TRẦN NA ĐH Nông lâm Gia Rai
07 10/02/2003 PHẠM VĂN HÙNG ĐH Bách Khoa Kinh
08 11/02/2003 TRẦN THIỆN TÂN ĐH sư phạm Kinh
09 17/02/2003 NGÔ THỊ BƯỞI ĐH Nông lâm Tày
10 26/02/2003 VÕ THỊ MAI LOAN ĐH Bách Khoa Kinh
11 01/03/2003 TRẦN LÊ QuỐC ĐH sư phạm Kinh
12 10/03/2003 TRẦN VĂN DŨNG ĐH sư phạm Tày

Yêu cầu: Tính điểm ưu tiên. Nếu không phải dân tộc kinh mà thi vào trường Đại học Nông Lâm hoặc Đại học Bách Khoa thì điểm ưu tiên là 1.5 còn lại điểm ưu tiên bằng 0. Trong đó điểm ưu tiên as double, dân tộc và trường đại học as string

dung2873
Bài viết: 1
Ngày tham gia: T.Tư 19/02/2014 9:13 am

Re: Trao đổi về Word VBA Mời vào đây!

Gửi bàigửi bởi dung2873 » T.Bảy 25/08/2018 3:09 pm

Chào mọi người mình có vài cái thắc mắc chưa thông mong mọi người chỉ giáo
Mình có gõ lại mấy đoạn code trong word, với mục đích là tìm câu và tách câu hỏi trắc nghiệm theo một điều kiện nhưng khi cho chạy bị lỗi không biết phải khắc phục như thế nào? Có kèm theo tập tin để tách
Sub Tach_cau_Mucdo()
ActiveDocument.Range.ListFormat.ConvertNumbersToText
Dim NameGoc, PathGoc, OldExt, OldName, NameTach, NameTam As String
NameGoc = ActiveDocument.Name
PathGoc = ActiveDocument.Path
OldExt = Split(NameGoc, ".")(UBound(Split(NameGoc, ".")))
OldName = Left(NameGoc, Len(NameGoc) - Len(OldExt))
Application.Visible = False
Dim socau As Integer
socau = 0
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Câu [0-9]{1,3}[.:][^9^32]"
.Forward = True
.Wrap = wdFindContinue
.MatchCase = True
.MatchWildcards = True
End With
Do While Selection.Find.Execute = True
socau = socau + 1
Loop
Selection.EndKey unit:=wdStory
Selection.ParagraphFormat.TabStops.ClearAll
Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(-0.5)
Selection.TypeParagraph
Selection.Font.Name = "Time New Roman"
Selection.Font.Size = 12
Selection.Font.Bold = True
Selection.Font.Color = wdColorDarkBlue
Selection.TypeText Text:="Câu " & socau + 1 & ". "
For i = 1 To socau
Cau = "Câu " & i
Cauke = "Câu " & i + 1
Selection.HomeKey unit:=wdStory
NameTach = "C" & 1 & "_" & NameGoc
Dim GocDoc, TamDoc As Document
Set GocDoc = ActiveDocument
Selection.Find.ClearFormatting
With Selection.Find
.Text = Câu & "([.:]*)" & Cauke
.MatchWildcards = True
If Selection.Find.Execute = True Then
Set TamDoc = Documents.Add(DocumentType:=wdNewBlankDocument)
Else
Exit Sub
End If
GocDoc.Activate
Selection.Copy
TamDoc.Activate
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End With
Selection.HomeKey unit:=wdStory
With Selection.Find
.Font.Color = wdColorPink
.Text = "(\[*\])"
.MatchCase = False
.MatchWildcards = True
.Execute
End With
Selection.Copy
NameTach = Selection.Text & NameTach
If Dir(PathName & "\" & OldName, vbDirectory) = "" Then
MkDir (PathGoc & "\" & OldName)
End If
NameTam = PathGoc & "\" & OldName & "\" & NameTach
TamDoc.SaveAs NameTam
ActiveWindow.Close (no)
Next
GocDoc.Activate
Application.Visible = True
MsgBox "Xong"
GocDoc.Close (no)
End Sub
Sub SapXepMucDo()
ActiveDocument.Range.ListFormat.ConvertNumbersToText
Dim NameGoc, PathGoc, OldExt, OldName, NameTach, NameTam As String
NameGoc = ActiveDocument.Name
PathGoc = ActiveDocument.Path
OldExt = Split(NameGoc, ".")(UBound(Split(NameGoc, ".")))
OldExt = "." & OldExt
OldName = Left(NameGoc, Len(NameGoc) - Len(OldExt))
OldName = "[" & OldName & "]"
Application.Visible = False
Dim socau As Integer
socau = 0
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Câu [0-9]{1,3}[.:][^9^32]"
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWildcards = True
End With
Do While Selection.Find.Execute = True
socau = socau + 1
Loop
Selection.EndKey unit:=wdStory
Selection.ParagraphFormat.TabStops.ClearAll
Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(-0.5)
Selection.TypeParagraph
Selection.Font.Name = "Time New Roman"
Selection.Font.Size = 12
Selection.Font.Bold = True
Selection.Font.Color = wdColorDarkBlue
Selection.TypeText Text:="Câu " & socau + 1 & ". "
For i = 1 To socau
Cau = "Câu " & i
Cauke = "Câu " & i + 1
Selection.HomeKey unit:=wdStory
NameTach = "C" & i & OldExt
Dim GocDoc, TamDoc As Document
Set GocDoc = ActiveDocument
Selection.Find.ClearFormatting
With Selection.Find
.Text = Câu & "([.:]*)" & Cauke
.MatchWildcards = True
If Selection.Find.Execute = True Then
Set TamDoc = Document.Add(DocumentType:=wdNewBlankDocument)
Else
Exit Sub
End If
GocDoc.Activate
Selection.Copy
TamDoc.Activate
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End With
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Cau & "([.:]*)" & Cauke
.Replacement.Text = Cau & "\1"
.MatchWildcards = True
.Execute Replace:=wdReplaceOne
End With
Selection.HomeKey unit:=wdStory
With Selection.Find
.Font.ColorIndex = wdColorPink
.Text = "(\1*\1)"
.MatchCase = False
.MatchWildcards = True
.Execute
End With
Selection.Copy
MaID = Selection.Text
mucdo = Right(MaID, 2)
NameTach = "[" & mucdo & MaID & NameTach
If Dir(PathGoc & "\" & OldName, vbDirectory) = "" Then
MkDir (PathGoc & "\" & OldName)
End If
NameTam = PathGoc & "\" & OldName & "\" & NameTach
TamDoc.SaveAs NameTam
ActiveWindow.Close (no)
Next
GocDoc.Activate
Dim FSO As Object, Content As String
Dim folder As Object, subfolder As Object
Dim GhepDoc As Document
Set FSO = CreateObject("Scripting.FileSystemObject")
folderPath = PathGoc & "\" & OldName
Set folder = FSO.GetFolder(folderPath)
DocName = PathGoc & "\[MucDo]" & NameGoc
If Dir(DocName) = "" Then
Set GhepDoc = Documents.Add(DocumentType:=wdNewBlankDocument)
ActiveDocument.SaveAs DocName
End If
For Each Wd In folder.Files
Selection.InsertFile FileName:=Wd.Path
Next
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Câu [0-9]{1,3}[.:][^9^32]'"
.Replacement.Text = "#"
.Forward = True
.MatchCase = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute Replace:=wdRelpaceAll
End With
Dim sott As Integer
sott = 0
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "#"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWildcards = False
End With
Do While Selection.Find.Execute = True
sott = sott + 1
Selection.ParagraphFormat.TabStops.ClearAll
Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(-0.5)
Loop
Selection.HomeKey unit:=wdStory
For k = 1 To sott
With Selection.Find
.Text = "#"
.Replacement.Text = "Câu " & k & ". "
.Replacement.Font.Color = wdColorDarkBlue
.Replacement.Font.Bold = True
.Forward = True
.MatchCase = True
.Execute Replace:=wdRelpaceAll
End With
Next
With Selection.Find
.Text = "^32^32"
.Replacement.Text = " "
.Forward = False
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWildcards = False
Do While .Execute
.Execute Replace:=wdReplaceAll
Loop
End With
ActiveDocument.Save
ActiveWindow.Close

Kill (folderPath & "\*.doc")
RmDir (folderPath)

Application.Visible = True
MsgBox "Xong"
GocDoc.Close (no)
End Sub
Sub SapXepID()
ActiveDocument.Range.ListFormat.ConvertNumbersToText
Dim NameGoc, PathGoc, OldExt, OldName, NameTach, NameTam As String
NameGoc = ActiveDocument.Name
PathGoc = ActiveDocument.Path
OldExt = Split(NameGoc, ".")(UBound(Split(NameGoc, ".")))
OldExt = "." & OldExt
OldName = Left(NameGoc, Len(NameGoc) - Len(OldExt))
OldName = "[" & OldName & "]"
Application.Visible = False
Dim socau As Integer
socau = 0
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Câu [0-9]{1,3}[.:][^9^32]"
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWildcards = True
End With
Do While Selection.Find.Execute = True
socau = socau + 1
Loop
Selection.EndKey unit:=wdStory
Selection.ParagraphFormat.TabStops.ClearAll
Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(-0.5)
Selection.TypeParagraph
Selection.Font.Name = "Time New Roman"
Selection.Font.Size = 12
Selection.Font.Bold = True
Selection.Font.Color = wdColorDarkBlue
Selection.TypeText Text:="Câu " & socau + 1 & ". "
For i = 1 To socau
Cau = "Câu " & i
Cauke = "Câu " & i + 1
Selection.HomeKey unit:=wdStory
NameTach = "C" & i & OldExt
Dim GocDoc, TamDoc As Document
Set GocDoc = ActiveDocument
Selection.Find.ClearFormatting
With Selection.Find
.Text = Câu & "([.:]*)" & Cauke
.MatchWildcards = True
If Selection.Find.Execute = True Then
Set TamDoc = Document.Add(DocumentType:=wdNewBlankDocument)
Else
Exit Sub
End If
GocDoc.Activate
Selection.Copy
TamDoc.Activate
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End With
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Cau & "([.:]*)" & Cauke
.Replacement.Text = Cau & "\1"
.MatchWildcards = True
.Execute Replace:=wdReplaceOne
End With
Selection.HomeKey unit:=wdStory
With Selection.Find
.Font.Color = wdColorPink
.Text = "(\[*\])"
.MatchCase = False
.MatchWildcards = True
.Execute
End With
Selection.Copy
MaID = Selection.Text
mucdo = Right(MaID, 2)
NameTach = MaID & NameTach
If Dir(PathGoc & "\" & OldName, vbDirectory) = "" Then
MkDir (PathGoc & "\" & OldName)
End If
NameTam = PathGoc & "\" & OldName & "\" & NameTach
TamDoc.SaveAs NameTam
ActiveWindow.Close (no)
Next
GocDoc.Activate
Dim FSO As Object, Content As String
Dim folder As Object, subfolder As Object
Dim GhepDoc As Document
Set FSO = CreateObject("Scripting.FileSystemObject")
folderPath = PathGoc & "\" & OldName
Set folder = FSO.GetFolder(folderPath)
DocName = PathGoc & "\[ID]" & NameGoc
If Dir(DocName) = "" Then
Set GhepDoc = Documents.Add(DocumentType:=wdNewBlankDocument)
ActiveDocument.SaveAs DocName
End If
For Each Wd In folder.Files
Selection.InsertFile FileName:=Wd.Path
Next
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^P^P"
.Replacement.Text = "^P"
.Forward = True
.MatchCase = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute Replace:=wdRelpaceAll
End With
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Câu [0-9]{1,3}[.:][^9^32]"
.Replacement.Text = "#"
.Forward = True
.MatchCase = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Dim sott As Integer
sott = 0
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "#"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWildcards = False
End With
Do While Selection.Find.Execute = True
sott = sott + 1
Selection.ParagraphFormat.TabStops.ClearAll
Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(-0.5)
Loop
Selection.HomeKey unit:=wdStory
For k = 1 To sott
With Selection.Find
.Text = "#"
.Replacement.Text = "Câu " & k & ". "
.Replacement.Font.Color = wdColorDarkBlue
.Replacement.Font.Bold = True
.Forward = True
.MatchCase = True
.Execute Replace:=wdRelpaceAll
End With
Next
With Selection.Find
.Text = "^32^32"
.Replacement.Text = " "
.Forward = False
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWildcards = False
Do While .Execute
.Execute Replace:=wdReplaceAll
Loop
End With
ActiveDocument.Save
ActiveWindow.Close

Kill (folderPath & "\*.doc")
RmDir (folderPath)

Application.Visible = True
MsgBox "Xong"
GocDoc.Close (no)
End Sub
Tập tin đính kèm
VINHPHUC1.rar
(915.48 KiB) Đã tải 10 lần


Quay về “Visual Basic for Application (VBA)”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách