我有一个带有下划线文字的word文件。我想将文本转换为Excel工作表。
答案 0 :(得分:0)
最后我找到了答案。希望这会有所帮助。
Private Sub underlined()
With Me.OpenFileDialog1
If .ShowDialog = System.Windows.Forms.DialogResult.OK Then
Dim objWordApp As Word.Application
objWordApp = CreateObject("Word.Application")
objWordApp.Visible = True
Dim objDoc As Word.Document = objWordApp.Documents.Open(.FileName)
Dim under As Range
Dim list_underline As New List(Of String)
under = objDoc.Content
With under.Find
.Text = ""
.Forward = True
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.MatchPhrase = False
.Replacement.Text = ""
.Font.Underline = WdUnderline.wdUnderlineSingle
.Wrap = WdFindWrap.wdFindStop
End With
under.Find.Execute()
While under.Find.Found
under.Select()
'under.Comments.Add(under, "Underlined Trouvé = " & under.Text)
list_underline.Add(under.Text)
under.Find.Execute()
End While
With Me.SaveFileDialog1
If .ShowDialog = System.Windows.Forms.DialogResult.OK Then
Dim app As New Excel.Application
Dim workbook As Excel.Workbook
Dim sheet As Microsoft.Office.Interop.Excel.Worksheet
workbook = app.Workbooks.Add()
workbook.Sheets.Select()
sheet = workbook.Sheets("Feuil1")
sheet.Cells(1, 1) = "Intitulée"
For i As Integer = 0 To list_underline.Count - 1
sheet.Cells(i + 2, 1) = list_underline(i)
Next
sheet.SaveAs(.FileName)
workbook.Close()
app.Quit()
releaseObject(app)
releaseObject(workbook)
releaseObject(sheet)
MsgBox("good job")
End If
End With
End If
End With
End Sub