Подпрограмма разделения шапки

Attribute VB_Name = "РазделениеШапки"

Option Explicit

Sub RazdelShapki(ИсхСтрока As String, Shapka() As String, KolGraf As Integer)

Dim Field As String

Dim HT As String * 1

Dim theLength As Integer

Dim k As Integer, p1 As Integer, p2 As Integer

HT = Chr(9)

theLength = Len(ИсхСтрока)

ИсхСтрока = ИсхСтрока & HT

k = 0

p1 = 0

Do While p1 < theLength

p2 = InStr(p1 + 1, ИсхСтрока, HT, vbBinaryCompare)

Field = Mid(ИсхСтрока, p1 + 1, p2 - p1 - 1)

ReDim Preserve Shapka(k)

Shapka(k) = Field

k = k + 1

p1 = p2

Loop

KolGraf = k

End Sub

Подпрограмма разделения таблицы

Sub RazdelTabl(ИсхСтрока As String, Zapis As Struct2, KolGraf As Integer)

Dim Field As String

Dim HT As String * 1, Minus As String * 1

Dim theLength As Integer

Dim k As Integer, p1 As Integer, p2 As Integer

HT = Chr(9)

Minus = Chr(45)

theLength = Len(ИсхСтрока)

ИсхСтрока = ИсхСтрока & HT

k = 0

p1 = 0

Do While p1 < theLength

p2 = InStr(p1 + 1, ИсхСтрока, HT, vbBinaryCompare)

Field = Mid(ИсхСтрока, p1 + 1, p2 - p1 - 1)

If k = 0 Then

Zapis.Марка = Field

Else

Zapis.Значение(k - 1) = CStr(Field)

End If

k = k + 1

p1 = p2

Loop

End Sub

Подпрограмма вывода в файл

Sub ExportAsText(FullNameVyhod As String, FL As String, SL As String, _

KolParam As Integer, Ukaz() As Integer)

'Вывод таблицы параметров в текстовый файл FullNameVyhod,

'Если файла FullNameVyhod нет, он создаётся

'Если файл FullNameVyhod есть, он перезаписывается

' Умаров М.Р, 08.06.12.

Const RowShapka = 3

Dim HighIndex As Integer

Dim p As Integer, q As Integer, r As Integer

Dim HT As String * 1

Dim VyhodStroka As String, Ch As String

Dim nf As Integer

HighIndex = UBound(Ukaz)

HT = Chr(9)

VyhodStroka = ""

nf = FreeFile()

' Открытие файла для сохранения

Open FullNameVyhod For Output As #nf

' Запись таблицы в файл (построчно)

Print #nf, FL; 'Первая строка шапки

Print #nf, "" 'Переход на новую строку

Print #nf, SL; 'Вторая строка шапки

Print #nf, "" 'Переход на новую строку

' Формируем Строку для записи в текстовый файл

For r = 0 To HighIndex

p = Ukaz(r)

VyhodStroka = VyhodStroka + Cells(RowShapka + r + 1, 1)

For q = 0 To KolParam - 1

Ch = Cells(RowShapka + r + 1, q + 2)

VyhodStroka = VyhodStroka + Ch + HT

Next q

VyhodStroka = VyhodStroka + (Chr(13) & Chr(10)) 'Переход на новую строку

Next r

' Записываем получившуюся строку в файл

Print #nf, VyhodStroka

' Закрываем файл

Close #nf

End Sub

Подпрограмма вывода на рабочий лист

Sub OutWSh(nameWS As String, S1 As String, S2() As String, _

Tabliza() As Struct2, KolParam As Integer, Ukaz() As Integer)

'Вывод таблицы параметров на раб. лист nameWS

'Если листа nameWS нет, он создаётся в конце книги

'Если лист nameWS есть, он очищается

'S1 и S2 первые строки исходного набора;

'Tabliza - содержательная часть таблицы

'Ukaz - вектор указателей

' Умаров М.Р, 08.06.12.

'

Dim p As Integer, q As Integer, r As Integer

Dim HighIndex As Integer

Dim kW As Integer

Const RowShapka = 3

Call AddWSh(nameWS)

HighIndex = UBound(Ukaz)

Range("a1").Value = S1

For q = 0 To KolParam

Cells(RowShapka, q + 1).Value = S2(q)

Next q

For r = 0 To HighIndex

p = Ukaz(r)

Cells(RowShapka + r + 1, 1) = Tabliza(p).Марка

For q = 0 To KolParam - 1

Cells(RowShapka + r + 1, q + 2) = Tabliza(p).Значение(q)

Next q

Next r

End Sub