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

Автор Space, 20.06.15, 17:33:44

« предыдущая - следующая »

0 Пользователей и 1 гость просматривают эту тему.

Space

20.06.15, 17:33:44 Последнее редактирование: 20.06.15, 23:25:42 от 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
+ Благодарностей: 1

IgorT

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

Golovanev

Добрый
Форматок
Макрос
Выполненный
На рассмотрение
+ Благодарностей: 1

IgorT


Golovanev

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

IgorT

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

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

Space

Цитата: IgorT от 20.06.15, 21:31:46
А как Вашей функцией пользоваться?

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

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

Helicoid

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

Space

Цитата: Helicoid от 21.06.15, 09:33:16
А нельзя сделать чтобы макрос еще извлекал и коэффициент кратности? А то формат А4х4 считается как А4.


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


Alnigo

Цитата: IgorT от 20.06.15, 22:25:59
....
А Фамилия ника бросилось. Очень уж провоцирующее.
....

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

Space

28.06.15, 15:46:45 #10 Последнее редактирование: 28.06.15, 21:41:10 от Space
Небольшое улучшение:
1. Добавил отдельную кнопку "Очистить" таблицу. Теперь можно последовательно добавлять файлы в таблицу, расширяя её.
+ Благодарностей: 2