#1
|
|||
|
|||
Set Excel Range using Word
Hi, all. I am at a stand still and I could really use someones help. I have a program in Word 2013. The program is moving some data from a Word table to Excel 2013. After the program moves the data, i need to add some formulas and formatting to the excel file. After I insert the formulas into excel I want to copy the formulas and paste them into the excel cells to fill the cells in the columns. When my program gets to the line that says Set FormulaPasteArea it stops and gives me an object error 424. I don't know a lot about programming and this has me completely stumped. If someone could please give me a suggestion as to what i should be looking for or maybe how to solve this problem I would appreciate it. I think the object is the workbook, the worksheet, and the range, so I am not sure what is missing? It may be that i don't know what an object is? 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 EEname As String, EENumber As String, EEDpt As String, HireDAte As String, AccrualDate As String, HoursWorked As String Dim SickHoursAccrued As String, SickHoursTaken As String, VacationHoursAccrued As String, VacationHoursTaken As String Dim FormulaPasteArea As Range Dim ix As Long Dim lrow As Long Dim lcol As Long Const LK1 As String = "AccVAC" 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 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 EEname = "=TRIM(LEFT(A1,SEARCH({" & """" & "A " & """" & ",0,1,2,3,4,5,6,7,8,9},A1)-1))" EENumber = "=MID(A1,SEARCH({" & """" & "A " & """" & ",0,1,2,3,4,5,6,7,8,9},A1)+4,4)" EEDpt = "=MID(A1,SEARCH({" & """" & "A " & """" & ",0,1,2,3,4,5,6,7,8,9},A1)+12,4)" HireDAte = "=LEFT(A2,10)" AccrualDate = "=MID(A2,SEARCH("" "",A2),LEN(A2)-16)" xlbook.sheets(1).Range("B:F").EntireColumn.Insert xlbook.sheets(1).Range("B1").Formula = EEname 'Column 2 xlbook.sheets(1).Range("C1").Formula = EENumber 'Column 3 xlbook.sheets(1).Range("D1").Formula = EEDpt 'Column 4 xlbook.sheets(1).Range("E1").Formula = HireDAte 'Column 5 xlbook.sheets(1).Range("F1").Formula = AccrualDate 'Column 6 xlbook.sheets(1).Range("E1").NumberFormat = "m/d/yyyy" xlbook.sheets(1).Range("F1").NumberFormat = "m/d/yyyy" HoursWorked = "=IF(LEFT(G1,7)*1=" & SickFactor & " ,0,MID(G1,1,7))" SickHoursAccrued = "=MID(g1,16,7)" SickHoursTaken = "=MID(g1,24,7)" VacationHoursAccrued = "=IF(OR(LEFT(G2,7)*1=3.08,LEFT(G2,7)*1=4.62,LEFT(G2,7)*1=6.16,LEFT(G2,7)*1=7.7),LEFT(G2,7),MID(G2,9,7))" VacationHoursTaken = "=Mid(g2, 16, 7)" xlbook.sheets(1).Range("H:L").EntireColumn.Insert xlbook.sheets(1).Range("H1").Formula = HoursWorked 'Column 8 xlbook.sheets(1).Range("I1").Formula = SickHoursAccrued 'Column 9 xlbook.sheets(1).Range("J1").Formula = SickHoursTaken 'Column 10 xlbook.sheets(1).Range("K1").Formula = VacationHoursAccrued 'Colum 11 xlbook.sheets(1).Range("L1").Formula = VacationHoursTaken 'Column 12 xlbook.sheets(1).Range("N1").Formula = "=LEFT(M1,8)" 'Column 13 xlbook.sheets(1).Range("O1").Formula = "=MID(M1,10,8)" 'Column 14 xlbook.sheets(1).Range("P1").Formula = "=RIGHT(M1,8)" 'Column 15 xlbook.sheets(1).Range("Q1").Formula = "=LEFT(M2,8)" 'Column 16 xlbook.sheets(1).Range("R1").Formula = "=MID(M2,10,8)" 'Column 17 xlbook.sheets(1).Range("S1").Formula = "=RIGHT(M2,8)" 'Column 18 'set the size of the range to copy formulas to Set FormulaPasteArea = xlbook.sheets(1).Range("A1", xlbook.sheets(1).Range("A65536").End(xlUp)).Row xlbook.sheets(1).Range("B1:F1").Copy xlbook.sheets(1).FormulaPasteArea.Offset(0, 1) xlbook.sheets(1).Range("H1:L1").Copy xlbook.sheets(1).FormulaPasteArea.Offset(0, 7) xlbook.sheets(1).Range("N1:S1").Copy xlbook.sheets(1).FormulaPasteArea.Offset(0, 12) 'copy entire worksheet and replace formulas with data xlbook.sheets(1).Cells.Copy xlbook.sheets(1).Range("A1").PasteSpecial Paste:=xlValues ' Delete nonesential lines 'In column A (1), Look for and remove rows wich contain the following: 'LK2 = "Group" With xlbook.sheets(1).Sheet1 lrow = xlbook.sheets(1).Range("a65536").End(xlUp).Row 'USE COLUMN A TO FIND THE LAST ROW OF DATA For ix = lrow To 1 Step -1 .Cells(ix, 1).Value = LK1 .Rows(ix).Delete Next ix End With 'wdDoc.Close 0 lbl_Exit: Set xlApp = Nothing Set xlbook = Nothing Set wdDoc = Nothing Exit Sub End Sub |
#2
|
||||
|
||||
You have defined FormulaPasteArea as a range. You are programming in Word so that would make it a Word range, hence the error. Change it to an object reference
Code:
Dim FormulaPasteArea As Object
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Wow, thanks for the help!! I tried changing Range, but it never occurred to me to just change it to object.
I can't thank you enough for your help |
#4
|
|||
|
|||
I changed my code as suggested but it still will not work. When the program executes the next line it gives me the error "application defined or object defined error". when i open the Immediate window and test for the FormulaPasteArea value i get the message "object variable with block variable not set". I don't know what to do to correct this. Could someone help me please?
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Selection (range) in Word or Excel table | NobodysPerfect | Word VBA | 2 | 09-16-2014 12:06 AM |
Find and Replace using Excel range | dmarie123 | Word VBA | 15 | 04-02-2013 07:54 AM |
Paste special an Excel range into Outlook as an Excel Worksheet | charlesh3 | Excel Programming | 3 | 02-04-2013 04:33 PM |
Excel - move with tab through named range | mjlaw | Excel | 4 | 03-26-2012 10:40 AM |
Through VBA, export range from Excel to Word | duugg | Word VBA | 0 | 08-24-2009 07:50 PM |