[giúp] VBA cho Word (1 người xem)

[vsxmm]

Tôi là một giáo viên ở trường THPT. Rất mong anh chị em trog diễn đàn giúp tôi với. tôi xin thành thật cảm ơn.


Sau đây là nhu cầu của tôi. Vì công việc phải tổng hợp đề nên tôi cần một code làm được hai yêu cầu sau (nếu không thì yêu cầu số 1 tôi mừng lắm rồi còn số 2 tôi tự làm tay.) Nếu code mà chạy được 2 yêu cầu thì hỏi để chọn yêu cầu 1 (Tạo đề thi từ đề gốc) hoặc chọn yêu cầu 2 (Chuyển đáp án vào đề gốc).

Yêu cầu 1:

- Dò câu trong file degoc.docx Lấy đáp án điền vào file DA.xlsx trong thư mục “KQ”

- Sau đó copy file degoc.docx vào thư mục “KQ” đổi tên thành tên “de.docx”

- Trong File de.docx, in đậm các ký tự A. B. C. D. ở đầu các phương án chọn, bỏ các ký hiệu gạch chân tại các phương án đúng (ví dụ: A. thành A. hoặc A. thành A.)

- Chuyển đáp án trong file “DA.xlsx” sang cuối file “de.docx” (yêu cầu này có tùy chọn đồng ý mới chuyển vào)

Yêu cầu 2:

- Dò đáp án trong file “DA.xlsx” rồi gạch chân tương ứng vào câu đó trong file degoc.docx

Cảm ơn anh chị em trong diễn đàn quan tâm.
Vì cũng gần thi nên tôi hy vọng có ai giúp được sớm.

 

[befaint]

1/ Trong file degoc.docx thì đáp án là những chỗ được Gạch chân đó hả?
2/ Thực hiện cho loạt file degoc.docx phải không? Lấy đáp án của file degoc(i).docx cho vào cột (i) file excel, tiếp đến copy file degoc(i).docx vào thư mục KQ và đổi tên thành de(i).docx ??

 

[vsxmm]

1/ Trong file degoc.docx thì đáp án là những chỗ được Gạch chân đó hả?
2/ Thực hiện cho loạt file degoc.docx phải không? Lấy đáp án của file degoc(i).docx cho vào cột (i) file excel, tiếp đến copy file degoc(i).docx vào thư mục KQ và đổi tên thành de(i).docx ??

đáp án là chỗ được gạch chân.
Thực hiện trên toàn bộ file đề gốc (đề có 50 câu - theo cấu trúc của bộ. Nếu được bạn cho mình chổ này tùy chọn số câu mình nhập vào để mình làm thêm cho từng chủ đề vì số lượng câu chắc nhiều hơn)
Hiện tại mình cần chỉnh lên 1 File degoc.docx đó thôi. Mỗi lần qua file khác. mình them code trở vào mình chạy cũng được. Như thế thôi cũng sướng lắm rồi mà. tiết kiệm được kha khá thời gian nữa. Bạn có thể code luôn với chứ thật tình mình không biết VBA này thật. trên word thì mình chịu.

 

[befaint]

đáp án là chỗ được gạch chân.
Thực hiện trên toàn bộ file đề gốc (đề có 50 câu - theo cấu trúc của bộ. Nếu được bạn cho mình chổ này tùy chọn số câu mình nhập vào để mình làm thêm cho từng chủ đề vì số lượng câu chắc nhiều hơn)
Hiện tại mình cần chỉnh lên 1 File degoc.docx đó thôi. Mỗi lần qua file khác. mình them code trở vào mình chạy cũng được. Như thế thôi cũng sướng lắm rồi mà. tiết kiệm được kha khá thời gian nữa. Bạn có thể code luôn với chứ thật tình mình không biết VBA này thật. trên word thì mình chịu.

Híc... Mình không biết bộ gì đâu. Hàng ngày ra đồng cắt cỏ về cho cá ăn sao biết được...

 

[quocgiacan]

Híc... Mình không biết bộ gì đâu. Hàng ngày ra đồng cắt cỏ về cho cá ăn sao biết được...

Cá mà ăn được cỏ của em chỉ có "cá độ" thôi! khà khà khà.

 

[VetMini]

Nếu muốn làm việc đúng đắn thì loại bài thi trắc nghiệm thế này nên dùng Access để giữ câu hỏi, câu trả lời.
Dùng Word vừa khó code, vừa khó kiểm soát chỗ sai/lỗi.

 

[VMH0307]

Bạn thử dùng code sau trong VBA của word nhé.
Đây là hàm lấy kết quả trắc nghiệm cho vào biến mảng, việc còn lại là ghi vào excel bạn thử nghiên cứu xem ^^
(Giả định rằng: định dạng của văn bản như file bạn gửi, tức các đáp án để ở 1 dòng riêng, các đáp án cách nhau bằng tab và trước đáp án A không có khoảng trống.)

Function getResult(oDocument As Document)
'MsgBox ActiveDocument.Content.ListParagraphs.Count

Dim TotalPara As Integer 'Tong so doan van
Dim iQuestion As Integer 'so cau hoi
Dim tmpArr()
Dim tmpResult As String
'Tong so doan van
TotalPara = ActiveDocument.Content.ListParagraphs.Count
iQuestion = 0

For i = 1 To TotalPara
tmpResult = ""
With ActiveDocument.Content.Paragraphs(i)
If .Range.Words(1) = "A" Or .Range.Words(1) = "B" Or .Range.Words(1) = "C" Or .Range.Words(1) = "D" Then
iQuestion = iQuestion + 1

With .Range.Characters
'Kiem tra dap an A
If .Item(1).Underline = wdUnderlineSingle Then
'MsgBox .Item(1)
tmpResult = tmpResult & .Item(1) 'Luu dap an A vao bien tam
End If

'Kiem tra cac dap an B, C, D
For j = 1 To .Count
If .Item(j) = vbTab Then
If .Item(j + 1).Underline = wdUnderlineSingle Then
'MsgBox .Item(j + 1)
tmpResult = tmpResult & .Item(j + 1) 'Luu dap an B, C, D vao bien tam
End If
End If
Next j
End With

'Tao mang ket qua
ReDim Preserve tmpArr(iQuestion)
tmpArr(iQuestion - 1) = tmpResult
End If
End With

Next i

getResult = tmpArr

End Function

 

[haonlh]

Câu 50. Các số nguyên dương n để số phức (trong biểu thức) là số thực ? số ảo ? là:

Câu hỏi này vô lý đó. Nếu đã thực thì không ảo.

 

[VetMini]

Câu 50. Các số nguyên dương n để số phức (trong biểu thức) là số thực ? số ảo ? là:

Câu hỏi này vô lý đó. Nếu đã thực thì không ảo.

Nói thiệt, tôi không đến nổi dốt toán lắm. Lượng toán tôi học qua ít nhất cũng 80% số lượng của một bằng ĐH chuyên toán
Nhưng cứ bảo tôi giải thử mấy cái đề thi của THPT thì chắc chỉ khoảng 6/10 là may.

 

[hoanganhdl]

Vì ko biết code trong word, nếu là mình, mình tạo fie degoc.xlsx, xử lý các kiểu rồi xuất file dạng PDF

 

[vsxmm]

Sau khi mày mò tôi viết như sau:

Attribute VB_Name = "LamdeCaNhan"
Sub A_Taode()
Dim idau, icuoi, ichay As Integer
Dim isocau As Byte
Dim ArrDA() As String
Dim MsgDK As VbMsgBoxResult

'--------lam cho code chay nhay va on dinh hon

'Phan khoi dau
MsgDK = vbYes
Do
    idau = Int(Val(InputBox("Nhap vao so cau dau tien", "So cau dau tien trong de", 1)) / 1)
    icuoi = Int(Val(InputBox("Nhap vao so cau cuoi", "So cau cuoi cung trong de", 50)) / 1)
Loop Until idau <= icuoi
ReDim Preserve ArrDA(idau To icuoi) As String
'Phan in dam dap an va luu ket qua vao mang ArrDA
MsgDK = MsgBox("Ban muon bat dau tu dau trang dau tien khong?", vbYesNo, "TUY CHON VI TRI BAT DAU")
If MsgDK = vbYes Then
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
End If
MsgDK = MsgBox("Ban muon bo dap an trong de khong?", vbYesNo, "TUY CHON BO DAP AN TRONG DE")
For ichay = idau To icuoi
ArrDA(ichay) = ""
For isocau = 1 To 4   'isocau la de duyet cac phuong an A, B, C, D.
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = Chr(64 + isocau) + "."
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
        Selection.Find.Execute
        Selection.Font.Bold = True
        Selection.Font.Color = 12611584 '12611584:mau xanh duong; wdColorRed: mau do
        If Selection.Font.Underline = wdUnderlineNone Then
            ArrDA(ichay) = ArrDA(ichay)
        Else
            ArrDA(ichay) = ArrDA(ichay) + Chr(64 + isocau)
            If MsgDK = vbYes Then
               Selection.Font.Underline = wdUnderlineNone
            End If
        End If
Next isocau
Next ichay
'Phan in dap an
'<!----Tuy chin In dap an vao cuoi cung moi de thi---!>
MsgDK = MsgBox("Ban muon in dap an vao dau cua de thi khong?", vbYesNo, "TUY CHON IN DAP AN")
If MsgDK = vbYes Then
    '<!----chen vao mot bang 15 cot va 2 hang------!>
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.Style = ActiveDocument.Styles("Normal")
    Application.Run MacroName:="MathTypeCommands.UIEnableDisable.UIUpdate"
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
        15, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
    With Selection.Tables(1)
        If .Style <> "Table Grid" Then
            .Style = "Table Grid"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
    End With
    '<!-----Dien dap an vao bang------!>
    For ichay = idau To icuoi
        Selection.TypeText Text:=Format(ichay, "0") + ArrDA(ichay)
        Selection.MoveRight Unit:=wdCell
    Next ichay
End If
'--------mo khoa cho tac dong vao excel
    
End Sub

Nhờ anh chị em chỉnh sửa với. Nói chung chạy thì ra được như yêu cầu tôi cần nhưng có mấy vấn đề nảy sinh.
1. Khi chạy từng, máy tính khi tìm từng phương án máy sẽ tô màu, in đậm luôn cho thấy trên màn hình chứ như code này thì nó chạy xong nới thấy. Trong khi chạy có một hộp thoại để chọn khi nào muốn dừng ngay tức thì.
2. Có cách nào thay thế cái đoạn tìm kiếm này không? Chứ hình như nó làm cho máy chạy vất vả hơn thì phải

For isocau = 1 To 4   'isocau la de duyet cac phuong an A, B, C, D.
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = Chr(64 + isocau) + "."
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With

3. Mấy câu lệnh sau trong word là gì? Có anh chị nào biết cho mình biết với

Application.Interactive = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

Vì máy tính hơi yếu nên muôn dừng lại tý cho cái máy tính của tôi nó chạy không nổi.
4. Cuối cùng nhờ anh chị em có thể tối ưu lại giúp với.
Cảm ơn anh chị em đã quan tâm nha

 

[vsxmm]

Nhờ bạn VMH0307 giải thích tý với chứ của bạn mình không biết dùng sao hết

 

[haonlh]

Bạn hỏi
Application.Interactive = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Mình chỉ biết
Application.ScreenUpdating = False
là tắt cập nhật màn hình. Như vậy tốc độ xử lý sẽ nhanh hơn.
Hai cái dòng đầu hình như chỉ dùng cho Excel