#1
|
|||
|
|||
excel vba to remove first row from each table in word document
I am hoping someone can help me as i have been working on this project for three days. I am at my wits end. Forgive me if this post is in the wrong forum but I'm not sure if it should be Word or Excel.
I have a word document with tables, and the number of tables varies each week. In the tables there are three columns. There are headers in the first two rows of the tables. The first two rows in the first column are merged. I want to remove the headers and combine the tables and make on big table and then copy and past to excel. I would like to do all this from excel. In my code, I am stuck at Sub Delete_Header_first_row. The code can find the number of tables in the document but it will not highlight or delete. When i run the routine the code bypasses the selecting and deleting and goes straight to the end. The code is in an excel 2010 file, and it is accessing the a word 2010 file. I don't have much experience with vba. (I am missing the rest of the code at the end of Sub OpenDoc that will fire Sub RemoveSectionBreaks, but I haven't got far enough into the program to worry about that yet.) I was able to get Sub Delete_Header_first_row to run when it was in word but once i moved it to excel, I cannot get it to work. If anyone can tell me what I am missing I would appreciate it. Code:
Option Explicit Dim Get_File As String Dim objWord As Object Dim objDoc As Object Dim objSelection As Object Dim i As Long Dim wdCharacter As Boolean Dim wdExtend As Boolean Sub OpenDoc() 'instructions to user MsgBox ("Please select the Word Document you would like to convert.") ' Display Open dialog With Application.FileDialog(1) ' msoFileDialogOpen .Filters.Clear .Filters.Add "Word documents", "*.doc*" If .Show Then Get_File = .SelectedItems(1) Else MsgBox "No document selected.", vbExclamation Exit Sub End If End With On Error Resume Next RUsure = MsgBox("Is this the correct Word Document?" & vbNewLine & Get_File, vbYesNo) If RUsure = vbYes Then ' See if Word is already running; if not, start it Set objWord = GetObject(Class:="Word.Application") If objWord Is Nothing Then Set objWord = CreateObject(Class:="Word.Application") If objWord Is Nothing Then MsgBox "Can't start Word.", vbExclamation Exit Sub End If End If End If ' Open document Set objDoc = objWord.Documents.Open(Filename:=Get_File) 'opens the word document objWord.Visible = True 'makes ms word application visible objDoc.Select Set objSelection = objWord.Selection Delete_Header_first_row End Sub Sub Delete_Header_first_row() Dim tblcnt As Integer With objDoc tblcnt = objDoc.Tables.Count For i = 1 To objDoc.Tables.Count objWord.Tables(i).Cells(1, 1).Select objWord.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend objDoc.Rows.Delete Next i End With RemoveSectionBreaks DeleteEmptyParas objDoc.Tables(1).Range.Copy End Sub Sub RemoveSectionBreaks() Dim rg As Range Set rg = activedocument.Range With rg.Find .Text = "^b" ' section break .Wrap = wdFindStop While .Execute rg.Delete Wend End With End Sub Sub DeleteEmptyParas() Dim MyRange As Range, oTable As Table, oCell As Cell Set MyRange = activedocument.Paragraphs(1).Range If MyRange.Text = vbCr Then MyRange.Delete Set MyRange = activedocument.Paragraphs.Last.Range If MyRange.Text = vbCr Then MyRange.Delete For Each oTable In activedocument.Tables #If VBA6 Then 'The following is only compiled and run if Word 2000 or 2002 is in use 'It speeds up the table and your code oTable.AllowAutoFit = False #End If 'Set a range to the para following the current table Set MyRange = oTable.Range MyRange.Collapse wdCollapseEnd 'if para after table empty, delete it If MyRange.Paragraphs(1).Range.Text = vbCr Then MyRange.Paragraphs(1).Range.Delete End If Next oTable End Sub |
#2
|
||||
|
||||
You are nearly there, but you are working in Excel and confusing Word VBA commands with those from Excel. If you are using LateBinding to Word, you cannot use any commands that are prefixed wd, so you must use their numeric equivalents, and Word components such as ranges and tables should be defined as objects. Then you get something like the following which will work from Excel.
Code:
Option Explicit Private Get_File As String Private objWord As Object Private objDoc As Object Private RUSure As Long Sub OpenDoc() 'instructions to user MsgBox ("Please select the Word Document you would like to convert.") ' Display Open dialog With Application.FileDialog(1) ' msoFileDialogOpen .Filters.Clear .Filters.Add "Word documents", "*.doc*" If .Show Then Get_File = .SelectedItems(1) Else MsgBox "No document selected.", vbExclamation Exit Sub End If End With On Error Resume Next RUSure = MsgBox("Is this the correct Word Document?" & vbNewLine & Get_File, vbYesNo) If RUSure = vbYes Then ' See if Word is already running; if not, start it Set objWord = GetObject(Class:="Word.Application") If objWord Is Nothing Then Set objWord = CreateObject(Class:="Word.Application") If objWord Is Nothing Then MsgBox "Can't start Word.", vbExclamation Exit Sub End If End If End If ' Open document Set objDoc = objWord.Documents.Open(Filename:=Get_File) 'opens the word document objWord.Visible = True 'makes ms word application visible Delete_Header_first_row objDoc RemoveSectionBreaks objDoc DeleteEmptyParas objDoc objDoc.Tables(1).Range.Copy End Sub Sub Delete_Header_first_row(odoc As Object) Dim oTable As Object For Each oTable In odoc.Range.Tables oTable.Rows(1).Delete Next oTable End Sub Sub RemoveSectionBreaks(odoc As Object) Dim rg As Object Set rg = odoc.Range With rg.Find .Text = "^b" ' section break .Wrap = 0 While .Execute rg.Delete Wend End With End Sub Sub DeleteEmptyParas(odoc As Object) Dim MyRange As Object, oTable As Object, oCell As Object Set MyRange = odoc.Paragraphs(1).Range If Len(MyRange) = 1 Then MyRange.Delete Set MyRange = odoc.Paragraphs.Last.Range If Len(MyRange) = 1 Then MyRange.Delete For Each oTable In odoc.Tables #If VBA6 Then 'The following is only compiled and run if Word 2000 or 2002 is in use 'It speeds up the table and your code oTable.AllowAutoFit = False #End If 'Set a range to the para following the current table Set MyRange = oTable.Range MyRange.Collapse 0 'if para after table empty, delete it If Len(MyRange.Paragraphs(1).Range) = 1 Then MyRange.Paragraphs(1).Range.Delete End If Next oTable End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Oh wow, I didn't even think to use table as object. this is great!!, thank you so very very much for your help. I don't have time to try the new code today but I hope to try it this evening. thanks again for your help and I'll keep you posted as to my progress. I just wish I knew more about VBA so I could help others, but I've got a lot to learn before that happens. Thanks again!!
|
#4
|
|||
|
|||
Graham- I tried the code you supplied but i'm having the same problem. Whenever the code reaches the Sub_delete_header_first_row, it doesn't delete anything and it just jumps to the end and stops. it doesn't even run Removesectionbreaks or deleteemptyparas.
Just for my own understanding, How does the code know what odoc and otable are when they have not been set? thanks for trying. i guess i'm not smart enough to figure this out. |
#5
|
||||
|
||||
The macro as supplied addresses every table in the document body. It works with a document with multiple tables as you described. If it isn't working for you I would need to see a copy of the document you are processing to establish why.
You can either post it to the forum as an attachment or send it to my e-mail supportATgmayor.com (change AT to @) and put your forum username in the subject line or the message will be discarded.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#6
|
|||
|
|||
I have sent an email with the document attached. I suspect that the code is having issues with the merged cell but I don't know enough about VBA, yet, to know if that is the cause or how to resolve it.
Thanks for taking the time to try and help me. |
#7
|
||||
|
||||
The document contained a mishmash of Excel and Word code. As were are working from Word, the code needs to be in a template (if it is just for you, the normal template will work) and should be something like the following. This will open a new Excel workbook and paste the data with the same cell content as it has in the processed Word table.
Code:
Option Explicit Sub Process_Word_File() Dim xlApp As Object Dim xlBook As Object Dim wdDoc As Document Dim wdFileName As Variant Dim i As Long wdFileName = BrowseForFile("Select the Word document to process", False) If wdFileName = "" Then GoTo lbl_Exit Set wdDoc = Documents.Open(wdFileName) Delete_Header_first_row RemoveSectionBreaks DeleteEmptyParas wdDoc.Tables(1).Range.Copy On Error Resume Next Set xlApp = GetObject(, "Excel.Application") If Err Then Set xlApp = CreateObject("Excel.Application") End If On Error GoTo 0 Set xlBook = xlApp.Workbooks.Add xlApp.Visible = True xlBook.sheets(1).Range("A1").PasteSpecial ("HTML") With xlBook.sheets(1).usedrange .VerticalAlignment = -4160 .HorizontalAlignment = -4131 .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = -1 .ShrinkToFit = False .ReadingOrder = -5002 .MergeCells = False .Columns.AutoFit End With 'wdDoc.Close 0 lbl_Exit: Set xlApp = Nothing Set xlBook = Nothing Set wdDoc = Nothing Exit Sub End Sub Sub Delete_Header_first_row() Dim oTable As Object For Each oTable In ActiveDocument.Range.Tables oTable.Cell(1, 1).Select Selection.MoveRight Unit:=1, Count:=2, Extend:=1 Selection.Rows.Delete Next oTable lbl_Exit: Set oTable = Nothing Exit Sub End Sub Sub RemoveSectionBreaks() Dim oRng As Object Set oRng = ActiveDocument.Range With oRng.Find .Text = "^b" ' section break .Wrap = 0 While .Execute oRng.Delete Wend End With lbl_Exit: Set oRng = Nothing Exit Sub End Sub Sub DeleteEmptyParas() Dim oPara As Object For Each oPara In ActiveDocument.Range.Paragraphs If Not oPara.Range.Information(12) Then If Len(oPara.Range) = 1 Then oPara.Range.Delete End If Next oPara lbl_Exit: Set oPara = Nothing Exit Sub End Sub Function BrowseForFile(Optional strTitle As String, Optional bExcel As Boolean) As String 'Graham Mayor 'strTitle is the title of the dialog box 'Set bExcel value to True to filter the dialog to show Excel files 'The default is to show Word files 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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#8
|
|||
|
|||
I've been out of town and haven't had a chance to try your corrections. Thanks again for helping me. I am wondering, Is there any way I can do what I want using Excel as the host? Don't get me wrong, I'm willing to learn more about Word, its just that being an Accountant, I am more comfortable using Excel.
|
#9
|
||||
|
||||
It probably could be redeveloped to work from Excel, but frankly as it is easier to process the document from Word. Word and Excel VBA are inherently similar so you shouldn't have any difficulty running the code from Word - http://www.gmayor.com/installing_macro.htm
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#10
|
|||
|
|||
Thanks Grahm for you help. I have been experimenting with the code you provided and it works. Many thanks for helping me organize my code. I was wondering how I get control of the excel workbook so that i can add a couple of columns in between A and B and B and C, so that i have a column of data empty column, column of data, empty column.
I have tried setting up a sub called insertcolumn, and I tried using getobject and createobject and just about everything inbetween, but I just can't seem to get control over Excel. I hate to ask, but could you give me a hint on what I need to do? |
#11
|
||||
|
||||
If you are referring to the earlier macro, this addresses the workbook with the variable xlBook. To insert columns between A & B and between B & C locate the line
Code:
xlBook.sheets(1).Range("A1").PasteSpecial ("HTML") Code:
xlBook.sheets(1).Range("B1").EntireColumn.Insert xlBook.sheets(1).Range("D1").EntireColumn.Insert
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#12
|
|||
|
|||
Thanks for taking the time to help me. I tried your suggestion but i get the message object doesn't support this property or method. I've tried moving the code to after the End With statement but I get the same results.
I've tried changing xlbook to Worksheets, i changed sheets (1), i added xlapp in front of xlbook, I tried xlbook.sheets (1).Insert.Column and about 20 other variations and combinations of commands but nothing seems to work. does the workbook need to have a name (be saved) before it will work? Do I need to activate a Library in my Preferences? I'm lost. I don't know if this matters, but when I hover my mouse over the declaration for xlbook nothing shows, but when i hover over xlapp it shows ="Microsoft Excel". For some reason it seems to get hung up on xlbook? Do you have any other suggestions I can try? |
#13
|
|||
|
|||
anyone else have any suggestions I can try?
|
#14
|
||||
|
||||
It appears that Graeme is the only one that has seen your document and workbook so it might be difficult for others to chime in with help.
If xlBook.sheets(1).Range("A1").PasteSpecial ("HTML") works successfully then adding the suggested lines immediately after that should still have the xlBook.sheets(1) object available to you. If that code to add a column is failing then perhaps there are merged cells that are causing the issue.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#15
|
|||
|
|||
thanks Andrew, very much, for trying to help me, i am still stuck. sorry for the delayed reply but i was giving up on the possibility of someone helping me. the word document had merged cell in the tables but Graham's code helped me get rid of them. so i'm not sure what else it could be. Thanks for the tip. I will try again and see how it turns out. Thanks
|
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Word Macro to remove Metadata to include Excel and Powerpoint files. | Dan_M | Word VBA | 2 | 04-04-2018 05:09 AM |
Creating a table in one document of WORD from EXCEL with Mail Merge | Joseph.Comerford@bentley. | Mail Merge | 1 | 04-18-2015 01:19 AM |
How to remove text from Word Document | foneunlocker | Word | 3 | 11-28-2014 12:51 AM |
VBA Code to take data from a table in word document and place it in a summary table | VBLearner | Word VBA | 1 | 03-09-2014 08:42 PM |
Remove all images from a Mac OS X Word 2008 Document? | qcom | Drawing and Graphics | 0 | 04-23-2011 06:48 PM |