#1
|
|||
|
|||
worksheetfunction not working when controlling excel from word.
Hi all, I've been looking at the internet for hours looking for a solution to my problem but I'm not having any luck. In the past I have asked the good people on this forum for help and have gotten fantastic replies that have help my protect along. I'm hoping someone may be able to take the time to look at the code I have so far and let me know why it is giving me errors. The error is "Method or Data Member not found" when it reaches the section of 'find the last row in the worksheet, and 'fill the worksheet with the ee name and ee number.
I've tried referencing the object, removing "worksheetfunction" , substituting Application with xlapp etc... but I just don't know enough about vba to find the solution to the problem. If someone could give me a pointer or two, and tell me where I am going wrong I would appreciate it. I have posted the code I have so far, please note there a lot of extra lines of text because I'm using code from other projects i have created and I'm trying to mesh them together. once i have the edited the code and have it working i will delete the unneeded lines, Code:
Sub Process_Word_File() Dim xlApp As Object Dim xlbook As Object Dim wdDoc As Document Dim wdFileName As Variant Dim i As Long Dim RegularHours As String, OtherHours As String, HoursCode As String, EEName As String, EENumber As String Dim DeductionLabels As String Dim FormulaPasteArea As Object, FormulaPasteAreaYTD As Object Dim ix As Long, ix2 As Long Dim LastRow As Long, lrow2 As Long Dim lcol As Long Dim Rcount As Long Const LK1 As String = "AccVAC" Const LK2 As String = "Delete" Const SickFactor = "0.03846" Const xlUp As Long = -4162 Const xlDown As Long = -4121 Const xltoLeft As Long = -4159 Const xltoRight As Long = -4161 Const xlPasteValues As Long = -4163 Const xlValues As Long = -4163 Const xldelimited As Long = 1 Const xlDoubleQuote As Long = 1 Const xlCellTypeFormulas = -4123 Const xlpart = 2 Const xlbyrows = 1 Const xlprevious = 2 Const xlformulas = 5 wdFileName = BrowseForFile("Select the Word document to process", False) If wdFileName = "" Then GoTo lbl_Exit Set wdDoc = Documents.Open(wdFileName) ' clean the word document of all text keeping the tables, and combine the tables and replace spaces and tabs with special characters so it can be separated into columns RemoveLines RemoveParagraphs DeleteHeaderRow ReplaceTabs ReplaceSpace 'copy the word table and paste into excel. 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 'With xlbook.sheets(2).usedrange '.VerticalAlignment = -4160 '.HorizontalAlignment = -4131 '.WrapText = False '.Orientation = 0 ' .AddIndent = False '.IndentLevel = -1 ' .ShrinkToFit = False ' .ReadingOrder = -5002 '.MergeCells = False '.Columns.AutoFit ' End With RegularHours = "=IF(ISNUMBER(SEARCH(""@"",G1)),LEFT(G1,SEARCH(""@"",G1)-1),IF(ISNUMBER(SEARCH(""(("",G1)),0,LEFT(G1,LEN(G1))))" 'RegularHours = "=IF(ISNUMBER(SEARCH("@",H2)),LEFT(H2,SEARCH("@",H2)-1),IF(ISNUMBER(SEARCH("((",H2)),0,LEFT(H2,LEN(H2))))" OtherHours = "=IF(ISERROR(SEARCH(""(("",G1)),0,IF(AND(ISNUMBER(SEARCH(""(("",G1)),ISNUMBER(SEARCH(""@"",G1))),MID(G1,SEARCH(""@"",G1)+1,SEARCH(""(("",G1)-1-SEARCH(""@"",G1)),LEFT(G1,SEARCH(""(("",G1)-1)))" 'OtherHours = "=IF(ISERROR(SEARCH("((",H2)),0,IF(AND(ISNUMBER(SEARCH("((",H2)),ISNUMBER(SEARCH("@",H2))),MID(H2,SEARCH("@",H2)+1,SEARCH("((",H2)-1-SEARCH("@",H2)),LEFT(H2,SEARCH("((",H2)-1)))" HoursCode = "=IF(ISERROR(SEARCH(""(("",G1)),"""",RIGHT(G1,LEN(G1)-SEARCH(""(("",G1)-1))" 'HoursCode = "=IF(ISERROR(SEARCH("((",H2)),"",RIGHT(H2,LEN(H2)-SEARCH("((",H2)-1))" EENumber = "=IF(ISERROR(SEARCH(""EE#"",a2)),"""",RIGHT(a2,4))" EEName = "=IF(ISERROR(SEARCH("","",a1)),"""",a1)" DeductionLabels = "=CONCATENATE(Q1,R1)" xlbook.Application.DisplayAlerts = False ' split employee names and department numbers and payrates into three columns using "@" as delimiter xlbook.sheets(1).Range("b:c").EntireColumn.Insert xlbook.sheets(1).Range("a:a").TextToColumns , Destination:=xlbook.sheets(1).Range("a1"), DataType:=xldelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, otherchar:="@", _ FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True 'Split codes for hours into its own column using "Space" as the delimiter xlbook.sheets(1).Range("e:e").EntireColumn.Insert xlbook.sheets(1).Range("d:d").TextToColumns , Destination:=xlbook.sheets(1).Range("d1"), DataType:=xldelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, _ FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 'split hours into regular and other using "@" as the delimiter xlbook.sheets(1).Range("e:e").EntireColumn.Insert xlbook.sheets(1).Range("d:d").TextToColumns , Destination:=xlbook.sheets(1).Range("d1"), DataType:=xldelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, otherchar:="@", _ FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 'insert columns for formulas to seperate reqular and other dollars. xlbook.sheets(1).Range("h:j").EntireColumn.Insert 'inster fourmulas for regular and other dollars. xlbook.sheets(1).Range("h1").Formula = RegularHours 'Column 8 xlbook.sheets(1).Range("i1").Formula = OtherHours 'Column 9 xlbook.sheets(1).Range("j1").Formula = HoursCode 'Column 10 'Split tax amounts and codes into seperate columns based on "(" delimiter xlbook.sheets(1).Range("m:m").EntireColumn.Insert xlbook.sheets(1).Range("l:l").TextToColumns , Destination:=xlbook.sheets(1).Range("l1"), DataType:=xldelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, otherchar:="(", _ FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 'split deductions and deduction codes into columns based on "Space" delimiter xlbook.sheets(1).Range("o:o").EntireColumn.Insert xlbook.sheets(1).Range("n:n").TextToColumns , Destination:=xlbook.sheets(1).Range("n1"), DataType:=xldelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, _ FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True xlbook.Application.DisplayAlerts = True xlbook.sheets(1).Range("b:c").EntireColumn.Insert xlbook.sheets(1).Range("c1").Formula = EENumber 'Column 3 xlbook.sheets(1).Range("b1").Formula = EEName 'Column 2 xlbook.sheets(1).Range("s1").Formula = EEName 'copy entire worksheet and replace formulas with data 'find the last row used in the worksheet With xlbook.sheets(1) If Application.worksheetfunction.CountA(.Cells) <> 0 Then 'took out application and added xlbook LastRow = .Cells.Find(What:="*", _ After:=xlbook.sheet(1).Range("A1"), _ Lookat:=xlpart, _ LookIn:=xlformulas, _ SearchOrder:=xlbyrows, _ SearchDirection:=xlprevious, _ MatchCase:=False).Row Else LastRow = 1 End If End With MsgBox LastRow xlbook.sheets(1).Range("a:b").Copy xlbook.sheets(1).Range("A:b").PasteSpecial Paste:=xlValues 'fill worksheet with ee name and ee number With xlbook.sheets(1).usedrange .Columns("A:A").Select .Selection.SpecialCells(xlCellTypeFormulas, 1).Select .Selection.FormulaR1C1 = "=R[-1]C" .Columns("A:A").Select .Columns("A:A").Copy .Columns("A:A").Select .Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .Application.CutCopyMode = False .Columns("B:B").Select .Selection.SpecialCells(xlCellTypeFormulas, 1).Select .Selection.FormulaR1C1 = "=R[-1]C" .Columns("B:B").Select .Columns("B:B").Copy .Columns("B:B").Select .Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .Application.CutCopyMode = False End With 'insert row for headers 'xlbook.Sheets(1).Range("a1").Entirerow.Insert 'HoursWorkedCurrent As String 'Dim SickHoursAccruedCurrent As String, SickHoursTakenCurrent As String, VacationHoursAccruedCurrent As String, VacationHoursTakenCurrent As String 'Dim SickHoursAccruedYTD As String, SickHoursTakenYTD As String, SickHoursAvailableYTD As String, VacationHoursAccruedYTD As String 'Dim VacationHoursTakenYTD As String, VacationHoursAvailableYTD As String 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 ReplaceTabs() 'Dim oRng As Object 'Set oRng = ActiveDocument.Range With Selection.Find .Text = "^t" .Replacement.Text = "@" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = True .MatchWholeWord = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub Sub ReplaceSpace() 'Dim oRng As Object 'Set oRng = ActiveDocument.Range With Selection.Find .Text = Space(2) .Replacement.Text = "(" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = True .MatchWholeWord = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub Sub RemoveHeader() Dim oRng As Object Dim i As Long Dim HeaderList HeaderList = Array("Employee", "Hours", "Earnings", "Gross", "Taxes", "Deductions", "Net Pay", "^p^p") For i = 0 To UBound(HeaderList) Set oRng = ActiveDocument.Range With oRng.Find .Text = HeaderList(i) .MatchCase = True .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Wrap = 0 While .Execute oRng.Delete Wend End With Next lbl_Exit: Set oRng = Nothing Exit Sub End Sub Sub Removetables() Dim oTable As Table For Each oTable In ActiveDocument.Tables oTable.Delete Next oTable End Sub Sub RemoveParagraphs() Dim oPara As Paragraph 'Dim answer For Each oPara In ActiveDocument.Paragraphs 'oPara.Range.Select 'answer = MsgBox(oPara.Range.Information(wdWithInTable)) If Not oPara.Range.Information(wdWithInTable) Then 'checks to see if paragraph is in table, if it is it skipps to the next paragraph, if its not it delets paragraph oPara.Range.Delete End If Next oPara End Sub Sub RemoveLines() ActiveDocument.Shapes.SelectAll Selection.Delete End Sub Sub DeleteHeaderRow() Dim sText As String sText = "RATE" Selection.Find.ClearFormatting With Selection.Find .Text = sText .MatchCase = True .MatchWholeWord = True .Wrap = wdFindContinue End With Do While Selection.Find.Execute If Selection.Information(wdWithInTable) Then Selection.Rows.Delete End If Loop 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() ' delete empty paragraphs 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 'End Function Sub DeleteTxtbox() Dim oShp As Word.Shape Dim i As Long For i = ActiveDocument.Shapes.Count To 1 Step -1 Set oShp = ActiveDocument.Shapes(i) If oShp.Type = msoTextBox Then oShp.Delete End If Next i End Sub |
#2
|
||||
|
||||
Instead of:
Application.worksheetfunction you should be using: xlApp.WorksheetFunction
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
||||
|
||||
Also if you are using late binding to Excel as implied by your designation of Object to the Excel parts, you need to substitute all the Excel specific commands such as 'xldelimited' for their numeric equivalents (in this instance 1). You have more than a few such commands in the code.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#4
|
|||
|
|||
Many thanks for the reply, i thought I tried that, but I think maybe my method of testing the code may have failed. I tried to edit the code and then I would use F8 and drag the yellow arrow down to that bit of code, then I would press F5. but i think the problem is that my code was reset causing the code to loose the stored variables? Is there a way I test just one section of my code? Sorry I'm getting a little off the topic.
i tried your suggestion, but now I i am getting a script out of range error. I added xlbook.sheet(1), in front of .cell, but I don't think that is helping things. I changed sheet to sheets, but nothing happened. I'm getting the script out of range error. Do you have any suggestions for that? Thanks again for taking the time to help me. |
#5
|
|||
|
|||
gmayor,
thanks for the reply and the suggestion. I have added constants to my code to take care of the Excel specific commands, at least I thought that is what I they were doing. Is that not correct? Is there better or more correct way to do this? |
#6
|
||||
|
||||
Quote:
Code:
Sub Test() Dim xlApp As Object, xlbook As Object, LastRow As Long Const xlpart = 2 Const xlbyrows = 1 Const xlprevious = 2 Const xlformulas = 5 Set xlApp = CreateObject("Excel.Application") Set xlbook = xlApp.workbooks.Add xlbook.Sheets(1).Range("A1").PasteSpecial With xlbook.Sheets(1) If xlApp.WorksheetFunction.CountA(.Cells) <> 0 Then LastRow = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlpart, _ LookIn:=xlformulas, _ SearchOrder:=xlbyrows, _ SearchDirection:=xlprevious, _ MatchCase:=False).Row Else LastRow = 1 End If End With MsgBox LastRow End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
Thanks, again, Paul for the suggestion. I guess I just don't know enough about vba to know the basics. Thanks for teaching me. I doubt I would know which bit of code to keep to do a test, but i appreciate the pointers. I can experiment with your advice and see how it goes.
Do you have any tips or hints as to why the code stops at Code:
LastRow = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlpart, _ LookIn:=xlformulas, _ SearchOrder:=xlbyrows, _ SearchDirection:=xlprevious, _ MatchCase:=False).Row |
#8
|
||||
|
||||
That part of the code works fine for me, as I expect you'd see by running the test macro I included it with.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
||||
|
||||
It doesn't work for me either - but the following does. Note that Paul's code will leave an invisible instance of Excel running, with a worksheet containing the pasted values, which you will need to close from Windows Task manager. If you are going to run Excel invisibly then ensure that you close the workbook and quit the Excel application when it is finished with. The following displays the workbook for testing purposes.
Code:
Sub Test() Dim xlApp As Object, xlbook As Object, LastRow As Long Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True Set xlbook = xlApp.workbooks.Add xlbook.Sheets(1).Range("A1").PasteSpecial With xlbook.Sheets(1) If xlApp.WorksheetFunction.CountA(.Cells) <> 0 Then LastRow = xlbook.Sheets(1).Range("A" & xlbook.Sheets(1).Rows.Count).End(-4162).Row Else LastRow = 1 End If End With MsgBox LastRow End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#10
|
|||
|
|||
Thanks for the help and the great suggestions. I did as Paul suggested and tried to run the snipet of code by itself but it failed, that is what prompted my question about why it stopped working. I try to do my part and i always try people suggestions, run the code, make corrections, and then do tests before I come back and say something isn't working. I Appreciate that you are taking the time to help me as I am trying to lean more about writing code.
I will work on the code this afternoon to try and get the kinks worked out, thanks for your suggestions. I'll keep you posted on the progress. Thanks!! |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Word to Excel Links Stop Working | DAC8190 | Word | 1 | 10-08-2015 05:56 PM |
Controlling Widows (single-word lines at the end of a paragraph) | downtownbooks | Word | 2 | 12-09-2014 03:57 PM |
Word and Excel stopped working | judyn | Office | 9 | 04-23-2013 05:10 AM |
Controlling search option in word | suvvi | Word | 0 | 08-05-2011 06:10 AM |
working with excel tables in MS word | radman154 | Word Tables | 1 | 03-25-2011 12:04 AM |