![]() |
#1
|
|||
|
|||
![]()
Hi community,
I'm sorry that I have questions to ask again... I would like to use word macro to copy specific text with specific font style from Word document to Microsoft Excel according to a list. I drafted the following macro based on VBA Express : Word - Extract sentences containing a specific word to excel file. However, I don't know how to copy specific text with specific font style from Word document to Microsoft Excel according to a list. Does anyone have any solution for that? Expected outcome (Excel file): Loading Google Sheets (Copy times new roman, font size 12) List: Loading Google Sheets Test document: Loading Google Docs Code:
Private strWorkbook As String Private strSheet As String Sub FindWordCopySentence() Dim appExcel As Object Dim strSheet As Object Dim aRange As Range Dim intRowCount As Integer intRowCount = 1 Set aRange = ActiveDocument.Range With aRange.Find Do .Text = "shall" ' the word I am looking for .Execute If .found Then aRange.Expand Unit:=wdSentence aRange.Copy aRange.Collapse wdCollapseEnd If objSheet Is Nothing Then Set appExcel = CreateObject("Excel.Application") 'Change the file path to match the location of your test.xls Set strSheet = BrowseForFile("Select Workbook", True) If Not strSheet = vbNullString Then strSheet = InputBox("Please enter the name of the Sheet", "Worksheet", "Please enter the name of the Sheet") If Not strSheet = vbNullString Then intRowCount = 1 End If objSheet.Cells(intRowCount, 1).Select objSheet.Paste intRowCount = intRowCount + 1 End If Loop While .found End With If Not objSheet Is Nothing Then appExcel.Workbooks(1).Close True appExcel.Quit Set objSheet = Nothing Set appExcel = Nothing End If Set aRange = Nothing End Sub Private Function BrowseForFile(Optional strTitle As String, Optional bExcel As Boolean) As String Dim fDialog As FileDialog On Error GoTo err_Handler Set fDialog = Application.FileDialog(msoFileDialogFilePicker) With fDialog .Title = strTitle .AllowMultiSelect = False .Filters.Clear If bExcel Then .Filters.add "Excel workbooks", "*.xls,*.xlsx,*.xlsm" Else .Filters.add "Word documents", "*.doc,*.docx,*.docm" End If .InitialView = msoFileDialogViewList If .Show <> -1 Then GoTo err_Handler: BrowseForFile = fDialog.SelectedItems.Item(1) End With lbl_Exit: Exit Function err_Handler: BrowseForFile = vbNullString Resume lbl_Exit End Function Last edited by syl3786; 04-08-2023 at 03:10 AM. Reason: forgot to add add attachment |
Tags |
excel copy text, word macro |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Text To Copy From Excel To Relevant Word Document | Covert Codger | Word VBA | 4 | 07-27-2022 11:40 PM |
![]() |
mihnea96 | Word VBA | 4 | 05-08-2017 12:09 PM |
how to copy addresses in word document to excel/mailmerge list | msnarayanan | Mail Merge | 4 | 10-17-2015 03:17 PM |
Copy Underline text from Word and Paste into excel | rfaris | Excel Programming | 7 | 10-05-2015 05:56 AM |
![]() |
romanticbiro | Word VBA | 12 | 12-03-2014 05:12 AM |