mdmackillop
02-10-2006, 05:02 PM
The code in this attachment exports tags from Word to be debugged in excel (well why not?). The portion after ******* runs fine in excel, but Intersect, ClearContents etc. are not being recognised. I have my Excel reference set, so what am I missing?
' Start Microsoft Excel and create a new Worksheet object.
Dim ExcelSheet As Object
Dim Cel
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.Application.Visible = True
'Indent data according to tag starts/ends
With ExcelSheet.ActiveSheet
For i = 1 To Tags
.Cells(i, 1) = MyData(i)
Next
j = 3
For i = 1 To Tags
j = j + 1
If j > k Then k = j
If Left(.Cells(i, 1), 1) = "/" Then
j = j - 1
.Cells(i, j) = .Cells(i, 1)
j = j - 1
Else
.Cells(i, j) = .Cells(i, 1)
If Right(.Cells(i, 1), 1) = "/" Then
j = j - 1
End If
End If
Next
'****************
j = .UsedRange.Columns.Count
'Clear single line tag items
For i = j To 3 Step -1
For Each Cel In Intersect(.Columns(i), .UsedRange)
If Right(Cel, 1) = "/" Then Cel.ClearContents
Next
Next i
'Clear matched items
For i = j To 3 Step -1
For Each Cel In Intersect(.Columns(j), .UsedRange)
If Cel <> "" Then
Cel.Select
If Cel.End(xlDown) = "/" & Split(Cel)(0) Then
Cel.ClearContents
Cel.End(xlDown).ClearContents
End If
End If
Next
Next i
'Hide blank rows
For i = 1 To .UsedRange.Rows.Count
If Excel.Application.WorksheetFunction.CountA(.Rows(i)) = 1 _
Then .Rows(i).RowHeight = 0
Next
' Start Microsoft Excel and create a new Worksheet object.
Dim ExcelSheet As Object
Dim Cel
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.Application.Visible = True
'Indent data according to tag starts/ends
With ExcelSheet.ActiveSheet
For i = 1 To Tags
.Cells(i, 1) = MyData(i)
Next
j = 3
For i = 1 To Tags
j = j + 1
If j > k Then k = j
If Left(.Cells(i, 1), 1) = "/" Then
j = j - 1
.Cells(i, j) = .Cells(i, 1)
j = j - 1
Else
.Cells(i, j) = .Cells(i, 1)
If Right(.Cells(i, 1), 1) = "/" Then
j = j - 1
End If
End If
Next
'****************
j = .UsedRange.Columns.Count
'Clear single line tag items
For i = j To 3 Step -1
For Each Cel In Intersect(.Columns(i), .UsedRange)
If Right(Cel, 1) = "/" Then Cel.ClearContents
Next
Next i
'Clear matched items
For i = j To 3 Step -1
For Each Cel In Intersect(.Columns(j), .UsedRange)
If Cel <> "" Then
Cel.Select
If Cel.End(xlDown) = "/" & Split(Cel)(0) Then
Cel.ClearContents
Cel.End(xlDown).ClearContents
End If
End If
Next
Next i
'Hide blank rows
For i = 1 To .UsedRange.Rows.Count
If Excel.Application.WorksheetFunction.CountA(.Rows(i)) = 1 _
Then .Rows(i).RowHeight = 0
Next