Sub tablo_word11()
Dim objDialog, intResult
Set objDialog = CreateObject("MSComDlg.CommonDialog")
objDialog.Flags = 4
objDialog.Filter = "DosyalarExcel Files (.doc)|*.doc"
objDialog.FilterIndex = 1
objDialog.InitDir = ThisWorkbook.Path
objDialog.ShowOpen
intResul = objDialog.Filename
If Len(intResul) = 0 Then
Dim Msg
Msg = "Dosya seçmediniz."
MsgBox Msg, vbInformation + vbCritical
Set objDialog = Nothing
Exit Sub
End If
Cells.ClearContents
Cells.Interior.ColorIndex = xlNone
yol = objDialog.Filename
Dim objWord As Word.Application
Dim docWord As Word.Document
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set docWord = objWord.Documents.Open(Filename:=yol, ReadOnly:=True)
objWord.ActiveDocument.Application.WindowState = wdWindowStateMinimize
Dim son
sat = 1
If objWord.ActiveDocument.Tables.Count > 0 Then
For i = objWord.ActiveDocument.Tables.Count To 1 Step -1
objWord.ActiveDocument.Tables(i).Delete
Next i
End If
For s = 1 To objWord.ActiveDocument.Paragraphs.Count
sat = sat + 1
Cells(sat, 1) = Replace(Replace(objWord.ActiveDocument.Paragraphs(s).Range.Text, Chr(13), ""), "", "")
If Cells(sat, 1).Value <> "" Then
If objWord.ActiveDocument.Paragraphs(s).Range.HighlightColorIndex = 6 Then
Cells(sat, 1).Interior.ColorIndex = 3
End If
End If
Next s
docWord.Close False
objWord.Quit
Set docWord = Nothing
MsgBox "işlem tamam"
End Sub