Xin Code VBA excel coppy các cụm từ có font màu đỏ trong word sang excel (2 người xem)

[thanhphuccd]

Kính nhờ anh chị cao thủ giúp code VBA trong excel để tự động coppy các cụm từ có font màu đỏ trong word vào excel

Bài đã được tự động gộp: 30/1/20

 

[batman1]

Tôi không là cao thủ nhưng cố tình chen chân vào, có gì bạn bỏ qua nhé.

Sub GetTextColor()
Const docFile = "file word mau.docx"    ' ten tap tin Word - phai nam cung thu muc voi tap tin Excel
Const wdColorRed = 255
Dim curr_row As Long
Dim wordApp As Object, wordDoc As Object, rngTemp As Object
'    khoi dong server WORD
    Set wordApp = CreateObject("Word.Application")
'    mo tap tin Word
    Set wordDoc = wordApp.Documents.Open(ThisWorkbook.Path & "\" & docFile)
    Set rngTemp = wordDoc.Range
'    xoa cac thiet lap cu
    rngTemp.Find.ClearFormatting
    rngTemp.Find.Replacement.ClearFormatting
'    cac thiet lap moi
    With rngTemp.Find
        .Forward = True
        .Format = True
'        tim cac doan co chu mau do
        .Font.Color = wdColorRed
        Do While .Execute
            With ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1)
                .Value = rngTemp.Text
                .Font.Color = RGB(255, 0, 0)
            End With
        Loop
    End With
    wordApp.Quit
    Set wordDoc = Nothing
    Set wordApp = Nothing
End Sub

 

[thanhphuccd]

Tôi không là cao thủ nhưng cố tình chen chân vào, có gì bạn bỏ qua nhé.

Sub GetTextColor()
Const docFile = "file word mau.docx"    ' ten tap tin Word - phai nam cung thu muc voi tap tin Excel
Const wdColorRed = 255
Dim curr_row As Long
Dim wordApp As Object, wordDoc As Object, rngTemp As Object
'    khoi dong server WORD
    Set wordApp = CreateObject("Word.Application")
'    mo tap tin Word
    Set wordDoc = wordApp.Documents.Open(ThisWorkbook.Path & "\" & docFile)
    Set rngTemp = wordDoc.Range
'    xoa cac thiet lap cu
    rngTemp.Find.ClearFormatting
    rngTemp.Find.Replacement.ClearFormatting
'    cac thiet lap moi
    With rngTemp.Find
        .Forward = True
        .Format = True
'        tim cac doan co chu mau do
        .Font.Color = wdColorRed
        Do While .Execute
            With ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1)
                .Value = rngTemp.Text
                .Font.Color = RGB(255, 0, 0)
            End With
        Loop
    End With
    wordApp.Quit
    Set wordDoc = Nothing
    Set wordApp = Nothing
End Sub

Mình đã áp dụng được vào công việc của mình. Mình cảm ơn bạn rất nhiều!