Подсчёт форматок (excel vba)

[Space]

Добрый день.
Долго искал на форуме прямые указания, как посчитать количество форматок, но находил лишь отрывки решений. Поэтому предлагаю на рассмотрение свой вариант, выполненный в виде макроса файла excel. Пользуйтесь.
_{Примечание: не забудьте разрешить исполнения макроса в файле excel.}

Сама функция подсчета форматок файла выглядит так:

Код Выделить Развернуть

Function GetFormatFile(ByRef iKompas As Kompas6API5.Application, _
                  ByVal PathFile As String) As Variant
Dim DateRange(0 To 6) As Variant
Dim kompas7 As kompasAPI7.IApplication
Set kompas7 = iKompas.ksGetApplication7
Dim doc7 As kompasAPI7.Documents
Set doc7 = kompas7.Documents
doc7.Open PathName:=PathFile, _
          Visible:=True, _
          ReadOnly:=True

Select Case doc7.Item(PathFile).DocumentType
    Case ksDocumentDrawing
        Dim DrawPar As kompasAPI7.LayoutSheets
        Set DrawPar = doc7.Item(PathFile).LayoutSheets
       
        Dim AmountSheet As Long
        AmountSheet = DrawPar.Count
       
        Dim i As Long
        For i = 0 To AmountSheet - 1
            DateRange(DrawPar.Item(i).Format.Format + 1) = DateRange(DrawPar.Item(i).Format.Format + 1) + 1
        Next
   
    Case ksDocumentSpecification
        Dim SpecPar7 As kompasAPI7.SpecificationStyle
        Set SpecPar7 = doc7.Item(PathFile).SpecificationDescriptions.Item(0).SpecificationStyle
       
        Dim SpecDoc As Kompas6API5.SpcDocument
        Set SpecDoc = iKompas.SpcActiveDocument
       
        DateRange(SpecPar7.Format.Format + 1) = SpecDoc.ksGetSpcDocumentPagesCount

    Case ksDocumentTextual
        Dim TextDoc As Kompas6API5.DocumentTxt
        Set TextDoc = iKompas.ActiveDocumentTxt
        DateRange(5) = TextDoc.ksGetDocumentPagesCount
   
End Select

DateRange(0) = doc7.Item(PathFile).Name
DateRange(6) = DateRange(1) * 16 + DateRange(2) * 8 + DateRange(3) * 4 + DateRange(4) * 2 + DateRange(5)

doc7.Item(PathFile).Close (kdDoNotSaveChanges)
GetFormatFile = DateRange
End Function

[IgorT]

А как Вашей функцией пользоваться?

[Golovanev]

Добрый
Форматок
Макрос
Выполненный
На рассмотрение

[IgorT]

Шифровка?

[Golovanev]

Подсчёт сделанных ошибок, или  IgorT в глаза не бросилась малограмотность, торопыжничество или неуважение к Русскому Языку Space...

[IgorT]

Вообще-то нет... Я сам малограмашный
А Фамилия ника бросилось. Очень уж провоцирующее.

Ну так юзать сию функцию? Имхо зачинщику надо пример файла Exel выложить для понимания.

[Space]

А как Вашей функцией пользоваться?

Ну так юзать сию функцию? Имхо зачинщику надо пример файла Exel выложить для понимания.

Скачать архив с файлом в первом сообщении.

[Helicoid]

А нельзя сделать чтобы макрос еще извлекал и коэффициент кратности? А то формат А4х4 считается как А4.

[Space]

А нельзя сделать чтобы макрос еще извлекал и коэффициент кратности? А то формат А4х4 считается как А4.

Можно (и нужно), в работе кратность не применяю, поэтому про неё и забыл. Только теперь у меня сомнения по форме таблицы, из неё не видно кратности, но не уверен нужна ли она там.

[Alnigo]

....
А Фамилия ника бросилось. Очень уж провоцирующее.
....

Извиняюсь за "оффтоп". Если не секрет на что может спровоцировать "Космос"?

[Space]

Небольшое улучшение:
1. Добавил отдельную кнопку "Очистить" таблицу. Теперь можно последовательно добавлять файлы в таблицу, расширяя её.