120 lines
3.8 KiB
QBasic
120 lines
3.8 KiB
QBasic
|
Attribute VB_Name = "MainImpl"
|
|||
|
|
Option Explicit
|
|||
|
|
|
|||
|
|
Public Function Output2Excel(outWB As Excel.Workbook, frags As Collection)
|
|||
|
|
Dim dataSht As Excel.Worksheet: Set dataSht = outWB.Worksheets(1)
|
|||
|
|
Call InitOutputHeader(dataSht)
|
|||
|
|
Dim iPath As New API_Path: Call iPath.FromString(ActiveDocument.FullName)
|
|||
|
|
|
|||
|
|
dataSht.Cells(2, OES_SOURCE_LABEL) = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
|
|||
|
|
dataSht.Cells(2, OES_SOURCE) = iPath.GlobalToServer.Text
|
|||
|
|
|
|||
|
|
Dim aFrag As ItemFragment
|
|||
|
|
Dim nRow&: nRow = DATA_ROW_START
|
|||
|
|
For Each aFrag In frags
|
|||
|
|
Dim theRange As Word.Range: Set theRange = ActiveDocument.Range(aFrag.start_, aFrag.end_)
|
|||
|
|
|
|||
|
|
dataSht.Cells(nRow, OES_ID) = nRow - 1
|
|||
|
|
dataSht.Cells(nRow, OES_START) = CStr(theRange.Start)
|
|||
|
|
dataSht.Cells(nRow, OES_FINISH) = CStr(theRange.End)
|
|||
|
|
dataSht.Cells(nRow, OES_TYPE) = CStr(aFrag.id_)
|
|||
|
|
dataSht.Cells(nRow, OES_TEXT) = theRange.Text
|
|||
|
|
dataSht.Cells(nRow, OES_COMMENT) = ExtractCommentText(theRange)
|
|||
|
|
|
|||
|
|
nRow = nRow + 1
|
|||
|
|
Call CSE_ProgressBar.IncrementA
|
|||
|
|
Next aFrag
|
|||
|
|
|
|||
|
|
On Error Resume Next
|
|||
|
|
Call dataSht.Columns("A:F").Sort(key1:=dataSht.Range("B2"), order1:=xlAscending, key2:=dataSht.Range("C2"), order2:=xlDescending, Header:=xlYes)
|
|||
|
|
On Error GoTo 0
|
|||
|
|
End Function
|
|||
|
|
|
|||
|
|
Public Function TransferVisible(iSource As Word.Document, iDestination As Word.Document)
|
|||
|
|
Call iSource.Range.Copy
|
|||
|
|
Call iDestination.Paragraphs.Add
|
|||
|
|
Dim nStart&: nStart = iDestination.Paragraphs.Last.Range.Start
|
|||
|
|
Call iDestination.Paragraphs.Last.Range.Paste
|
|||
|
|
|
|||
|
|
Dim rFind As Word.Range: Set rFind = iDestination.Range
|
|||
|
|
rFind.Start = nStart
|
|||
|
|
Call rFind.Find.ClearFormatting
|
|||
|
|
Call rFind.Find.Replacement.ClearFormatting
|
|||
|
|
With rFind.Find
|
|||
|
|
.Font.Hidden = True
|
|||
|
|
.MatchWildcards = True
|
|||
|
|
.Text = "*"
|
|||
|
|
.Replacement.Text = ""
|
|||
|
|
.Forward = True
|
|||
|
|
Call .Execute(Replace:=wdReplaceAll)
|
|||
|
|
End With
|
|||
|
|
End Function
|
|||
|
|
|
|||
|
|
Public Function ScanFragmentsFrom(sFile$) As Collection
|
|||
|
|
Dim fso As New Scripting.FileSystemObject
|
|||
|
|
If VBA.LCase(fso.GetExtensionName(sFile)) = "txt" Then
|
|||
|
|
Set ScanFragmentsFrom = ScanTextFile(sFile)
|
|||
|
|
Else
|
|||
|
|
Set ScanFragmentsFrom = ScanXLFile(sFile)
|
|||
|
|
End If
|
|||
|
|
End Function
|
|||
|
|
|
|||
|
|
' =====
|
|||
|
|
Private Function InitOutputHeader(target As Excel.Worksheet)
|
|||
|
|
target.Cells(1, OES_ID) = "ID"
|
|||
|
|
target.Cells(1, OES_START) = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
|
|||
|
|
target.Cells(1, OES_FINISH) = "<22><><EFBFBD><EFBFBD><EFBFBD>"
|
|||
|
|
target.Cells(1, OES_TYPE) = "<22><><EFBFBD>"
|
|||
|
|
target.Cells(1, OES_TEXT) = "<22><><EFBFBD><EFBFBD><EFBFBD>"
|
|||
|
|
target.Cells(1, OES_COMMENT) = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
|
|||
|
|
End Function
|
|||
|
|
|
|||
|
|
Private Function ScanTextFile(sFile$) As Collection
|
|||
|
|
Dim fso As New Scripting.FileSystemObject
|
|||
|
|
Dim textIn As Object: Set textIn = fso.OpenTextFile(sFile)
|
|||
|
|
If textIn Is Nothing Then _
|
|||
|
|
Exit Function
|
|||
|
|
|
|||
|
|
Dim fragments As New Collection
|
|||
|
|
Dim frag As New ItemFragment
|
|||
|
|
While Not textIn.AtEndOfStream
|
|||
|
|
Dim text_line$: text_line = textIn.ReadLine
|
|||
|
|
If text_line = vbNullString Then _
|
|||
|
|
GoTo EXIT_LOOP
|
|||
|
|
|
|||
|
|
Dim elemArray() As String: elemArray = VBA.Split(text_line, vbTab)
|
|||
|
|
frag.start_ = CLng(elemArray(0))
|
|||
|
|
frag.end_ = CLng(elemArray(1))
|
|||
|
|
frag.id_ = elemArray(2)
|
|||
|
|
Call fragments.Add(frag.Clone)
|
|||
|
|
Wend
|
|||
|
|
EXIT_LOOP:
|
|||
|
|
Call textIn.Close
|
|||
|
|
Set ScanTextFile = fragments
|
|||
|
|
End Function
|
|||
|
|
|
|||
|
|
Private Function ScanXLFile(sFile$) As Collection
|
|||
|
|
Dim xlApp As New API_XLWrapper
|
|||
|
|
If xlApp.OpenDocument(sFile, bReadOnly:=True) Is Nothing Then _
|
|||
|
|
Exit Function
|
|||
|
|
|
|||
|
|
On Error GoTo SAFE_EXIT
|
|||
|
|
Dim fragments As New Collection
|
|||
|
|
Dim frag As New ItemFragment
|
|||
|
|
Dim iData As Excel.Worksheet: Set iData = xlApp.Document.Sheets(1)
|
|||
|
|
Dim nRow&: nRow = DATA_ROW_START
|
|||
|
|
Do While iData.Cells(nRow, OES_ID) <> vbNullString
|
|||
|
|
frag.start_ = iData.Cells(nRow, OES_START)
|
|||
|
|
frag.end_ = iData.Cells(nRow, OES_FINISH)
|
|||
|
|
frag.id_ = iData.Cells(nRow, OES_TYPE)
|
|||
|
|
Call fragments.Add(frag.Clone)
|
|||
|
|
nRow = nRow + 1
|
|||
|
|
Loop
|
|||
|
|
On Error GoTo 0
|
|||
|
|
|
|||
|
|
SAFE_EXIT:
|
|||
|
|
Call xlApp.ReleaseDocument
|
|||
|
|
Set ScanXLFile = fragments
|
|||
|
|
End Function
|
|||
|
|
|