Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming,microsoft.public.word.programming,microsoft.public.word.vba.general
|
|||
|
|||
Automating Excel from Word - How to Sort a Range of Cells
I have an application in which I am automating Excel from Word where the
application opens a series of Word documents that are protected for filling in forms and takes information from the formfields in each document and then populates cells in an Excel Worksheet that the application creates from an Excel Template (as well as inserting some of the information into a Word document). After the Excel spreadsheet has been populated with all of the required information, it is desired that the range of cells containing that information be sorted on the data in one of the columns. The only way that I have been able to do the sort is to use Set xlrange = tSheet.Range("A11:T" & j - 1) xlrange.Select oXL.SendKeys "%a%a" As the use of SendKeys seems to suffer the same reliability problems in Excel as it does in Word (though sometimes, it appears that it is necessary to resort to it), I would like to try and avoid using it. If I run the following code from Excel itself, on a Worksheet that contains three rows of data (rows 11, 12 and 13 - Hence j -1 = 13), the sort is performed: Dim tsheet As Worksheet Set tsheet = ActiveWorkbook.ActiveSheet Dim j As Long j = 14 tsheet.Sort.SortFields. _ Clear tsheet.Sort.SortFields. _ Add Key:=Range("A11"), SortOn:=xlSortOnValues, Order:=xlAscending, _ DataOption:=xlSortNormal With tsheet.Sort .SetRange Range("A11:T" & j - 1) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With It does not however work when used in the following code. Does anyone know how what I should use in the following code to do the sorting. Dim fname As String Dim PathToUse As String Dim oXL As Excel.Application Dim ETarget As Excel.Workbook Dim WTarget As Document Dim Source As Document Dim fd As FileDialog Dim drange As Range Dim strText As String Dim i As Long, j As Long Dim tSheet As Excel.Worksheet Dim ResidentName As String Dim xlrange As Excel.Range 'If Excel is running, get a handle on it; otherwise start a new instance of Excel On Error Resume Next Set oXL = GetObject(, "Excel.Application") If Err Then Set oXL = CreateObject("Excel.Application") End If 'Allow the user to select the folder containing the Word files to be processed Set fd = Application.FileDialog(msoFileDialogFolderPicker) With fd .Title = "Select the folder containing the files." If .Show = -1 Then PathToUse = .SelectedItems(1) & "\" Else End If End With Set fd = Nothing oXL.Visible = True 'Create a new workbook from the LongSheet template Set ETarget = oXL.Workbooks.Add(ThisDocument.Path & "\LongSheet.xlt") Set tSheet = ETarget.Sheets(1) tSheet.Activate 'Create a new Word document from the Daily Report template Set WTarget = Documents.Add("Daily Report.dot") If Len(PathToUse) = 0 Then Exit Sub End If fname = Dir$(PathToUse & "*.doc*") 'Set the first row of the spreadsheet into which data is to be inserted j = 11 'Open each document and extract the data from the formfields to populate the spreadsheet and the Word document While fname < "" Set Source = Documents.Open(PathToUse & fname) With Source ResidentName = .FormFields("ResidentName").Result ResidentName = Mid(ResidentName, InStr(ResidentName, ",") + 1) & " " & Left(ResidentName, InStr(ResidentName, ",") - 1) Set drange = WTarget.Tables(2).Cell(3, 3).Range drange.End = drange.End - 1 drange.Collapse wdCollapseEnd drange.InsertAfter .FormFields("MapNumber").Result _ & " " & ResidentName & vbCr tSheet.Range("A" & j) = .FormFields("MapNumber").Result tSheet.Range("C" & j) = .FormFields("Location").Result tSheet.Range("D" & j) = ResidentName tSheet.Range("E" & j) = .FormFields("Contact").Result tSheet.Range("F" & j) = ResidentName & vbLf & _ .FormFields("Address1").Result & vbLf & _ .FormFields("Address2").Result tSheet.Range("G" & j) = .FormFields("Phone").Result tSheet.Range("H" & j) = .FormFields("ContactDate").Result tSheet.Range("I" & j) = .FormFields("ContactDate").Result tSheet.Range("J" & j) = .FormFields("DEPC").Result j = j + 1 End With Source.Close wdDoNotSaveChanges fname = Dir$() Wend 'Sort the data in the spreadsheet 'This does not sort the worksheet ' tSheet.Sort.SortFields. _ ' Clear ' tSheet.Sort.SortFields. _ ' Add Key:=Range("A11"), SortOn:=xlSortOnValues, Order:=xlAscending, _ ' DataOption:=xlSortNormal ' With tSheet.Sort ' .SetRange Range("A11:T" & j - 1) ' .Header = xlNo ' .MatchCase = False ' .Orientation = xlTopToBottom ' .SortMethod = xlPinYin ' .Apply ' End With 'This does sort the worksheet Set xlrange = tSheet.Range("A11:T" & j - 1) xlrange.Select oXL.SendKeys "%a%a" 'Sort the information in the Word document Set drange = WTarget.Tables(2).Cell(3, 3).Range drange.End = drange.End - 1 drange.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", _ SortFieldType:=wdSortFieldNumeric, SortOrder:=wdSortOrderAscending Set drange = Nothing Set tSheet = Nothing Set ETarget = Nothing Set WTarget = Nothing Set Target = Nothing Set oXL = Nothing -- Thanks and Regards Doug Robbins - Word MVP, originally posted via msnews.microsoft.com |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sums; Automating range changes in non-neighbouring cells | Excel Discussion (Misc queries) | |||
vba code to insert an range of Excel cells into a Word document | Excel Programming | |||
Sort column by second word in cells | Setting up and Configuration of Excel | |||
Automating import of Word tables into Excel | Excel Discussion (Misc queries) | |||
Automating Word from Excel | Excel Programming |