VBScript

Поделиться1Четверг, 20 декабря, 2012г. 20:30:28

Автор: 6akJIAH
Администратор
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 12
Провел на форуме:
1 час 12 минут
Последний визит:
Понедельник, 11 февраля, 2013г. 00:57:09

Синтаксис VBScript
Основные принципы

Основные синтаксические принципы VBScript как языка программирования:
• VBScript нечувствителен к регистру;
• чтобы закомментировать код до конца строки, используется одинарная кавычка (') или команда REM;
• символьные значения должны заключаться в двойные кавычки;
• максимальная длина любого имени в VBScript (переменные, константы, процедуры) - 255 символов;
• начало нового оператора - перевод на новую строку (точка с запятой, как в C, Java, JavaScript для этого не используется);
• ограничений на максимальную длину строки нет. Несколько операторов в одной строке разделяются двоеточиями:
• можно объявлять и использовать переменные только одного типа данных - Variant.
Основные отличия VBScript от Visual Basic:
• VBScript - интерпретируемый язык;
• VBScript не требует, чтобы код скрипта был помещен внутрь блока Sub() или Function();
• нет команды Debug.Print (вместо нее можно использовать WScript.Echo);
Операторы VBScript

1. Арифметические операторы:
• сложение (+),
• вычитание (-),
• умножение (*),
• деление (/),
• возведение в степень (^).
• целочисленное деление (\),
• деление по модулю (Mod).

2. Оператор присваивания в VBScript - знак равенства (=). Не путать с оператором сравнения (тоже знак равенства)

3. Операторы сравнения в VBScript:
• равенство (=).
• больше, чем (>) и меньше, чем (<).
• больше или равно (>=) и меньше или равно (<=).
• не равно (<>).
• сравнение объектов (Is). Определяет, ссылаются объектные переменные на один и тот же объект или на разные.
Особенности сравнения строковых значений:
- при сравнении строковых значений учитывается регистр;
- пробелы в строковых значениях также учитываются;
Операторы сравнения всегда возвращают True (если утверждение истинно) или False (если утверждение ложно).

4. Логические операторы:
• And — логическое И.
• Or — логическое ИЛИ.
• Not — логическое отрицание.
• Xor — логическое исключение.
• Eqv — эквивалентность двух выражений,
• Imp — импликация.

5. Операторы конкатенации — (+) или (&).При использовании (&) производится автоматическое преобразование числовых значений в строковые, при использовании оператора (+) сложение строкового значения со значением типа Null дает Null.
Переменные и константы в VBScript

В VBScript все переменные объявляются как Variant.
подтипы данных для типа Variant:
• числовые:
• Byte — целое число от 0 до 255;
• Integer — целое число от -32 768 до 32 767;
• Long — большое целое число от -2 147 483 648 до 2 147 483 647;
• Currency — большое десятичное число с 19 позициями, включая 4 позиции после запятой;
• Decimal — еще большее десятичное число с 29 позициями (после занятой можно использовать от 0 до 28 позиций);
• Single и Double — значения с плавающей запятой (Double в 2 раза больше));
• строковые (String переменной длины (~ до 2 млрд. символов) и фиксированной длины (~ до 65400 символов))
• дата и время (Date — от 01.01.100 до 31.12.9999);
• логический (Boolean — может хранить только значения True и False);
• объектный (Object — хранит ссылку на любой объект в памяти);
Запретить использовать переменные без явного их объявления можно с помощью выражения Option Explicit.
Dim — это область видимости переменной. Предусмотрено 3 ключевых слова для определения области видимости переменных:
Dim — используется в большинстве случаев. Если переменная объявлена как Dim в области объявлений модуля, то она будет доступна во всем модуле, если в процедуре — только на время работы этой процедуры.
Private — при объявлении переменных в стандартных модулях VBScript значит то же, что и Dim. Отличия проявляются только при создании своих классов.
Public — такая переменная будет доступна всем процедурам во всех модулях данного проекта, если вы объявили ее в области объявлений модуля. Если вы объявили ее внутри процедуры, она будет вести себя как Dim.

Правила выбора имен в VBScript едины для переменных, констант, функций, процедур:
• имя должно начинаться с буквы;
• не должно содержать пробелов и символов пунктуации (исключение — символ подчеркивания);
• максимальная длина — 255 символов;
• должно быть уникальным в текущей области видимости;
• не допускается использовать зарезервированные слова.
Рекомендуется используется так называемое "венгерское" соглашение: имя переменной должно начинаться с префикса, записанного строчными буквами. Префикс указывает, что именно будет храниться в этой переменной:
• str (или s) — String, символьное значение;
• fn (или f) — функция;
• sub — процедура;
• c (или все буквы имени заглавные) — константа;
• b — Boolean, логическое значение (True или False);
• d — дата;
• obj (или o) — ссылка на объект;
• n — числовое значение;

http://greentracery.narod.ru/wmi/page2.html

Поделиться2Четверг, 20 декабря, 2012г. 20:55:46

Автор: 6akJIAH
Администратор
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 12
Провел на форуме:
1 час 12 минут
Последний визит:
Понедельник, 11 февраля, 2013г. 00:57:09

Как объединить построчно ячейки Excel с помощью VBScript ?
XLApp.ActiveWorkbook.ActiveSheet.Range("A28:F30").Merge=True

XLApp.ActiveWorkbook.ActiveSheet.Range("A28:F30").Merge(True)

Поделиться3Четверг, 20 декабря, 2012г. 20:56:50

Автор: 6akJIAH
Администратор
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 12
Провел на форуме:
1 час 12 минут
Последний визит:
Понедельник, 11 февраля, 2013г. 00:57:09

Создание файлов

Есть три способа создания пустого текстового файла (иногда называемого как «text stream»).

Первый способ — это использование метода CreateTextFile. В следующем примере показано, как создать текстовый файл, используя этот метод:

Dim fso, f1
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.CreateTextFile("c:\testfile.txt", True)

Пример использования данного метода см. в разделе «3.7. Пример работы с объектом FileSystemObject».

Второй способ — это использование метода OpenTextFile объекта FileSystemObject с набором флагов ForWriting. В следующем примере показано, как создать текстовый файл, используя этот метод:

Dim fso, ts
Const ForWriting = 2
Set fso = CreateObject("Scripting. FileSystemObject")
Set ts = fso.OpenTextFile("c:\test.txt", ForWriting, True)

Третий способ — это использование метода OpenAsTextStream с набором флагов ForWriting. В следующем примере показано, как создать текстовый файл, используя этот метод:

Dim fso, f1, ts
Const ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile ("c:\test1.txt")
Set f1 = fso.GetFile("c:\test1.txt")
Set ts = f1.OpenAsTextStream(ForWriting, True)

Добавление данных в файл

Однажды создав текстовый файл, вы можете добавлять в него данные, для чего нужно выполнить три действия:

Открыть текстовый файл
Записать данные
Закрыть файл

Для открытия существующего файла используйте метод OpenTextFile объекта FileSystemObject или метод OpenAsTextStream объекта File.

Для записи данных в текстовый файл используйте методы Write, WriteLine или WriteBlankLines объекта TextStream, в зависимости от задач, описанных в приведённой ниже таблице:

Задача Метод
Запись данных в текстовый файл без символа перехода на новую строку в конце Write
Запись данных в текстовый файл с символом перехода на новую строку в конце WriteLine
Запись одной или более пустых строк в открытый текстовый файл WriteBlankLines

Для закрытия текстового файла используйте метод Close объекта TextStream. Закрыть файл можно также методом Close объекта FileSystemObject. Пример использования данных методов см. в разделе «3.7. Пример работы с объектом FileSystemObject».

ПРИМЕЧАНИЕ
Символ новой строки содержит символ или символы (зависит от операционной системы) для перевода курсора в начало новой строки (возврат каретки/перевод строки). Следует учитывать, что некоторые строки уже могут иметь в конце эти непечатаемые символы.

В следующем примере показано, как выполняется запись данных в открытый файл всеми тремя методами, затем файл закрывается:

Sub CreateFile()
Dim fso, tf
Set fso = CreateObject("Scripting.FileSystemObject")
Set tf = fso.CreateTextFile("c:\testwritefile.txt", True)
' Записать строку с переводом на новую строку.
tf.WriteLine("Тестирование 1, 2, 3.")
' Записать три пустых строки в файл.
tf.WriteBlankLines(3)
' Записать строку
tf.Write ("Это тест")
tf.Close
End Sub

Чтение файлов

Для чтения данных из файла используйте методы Read, ReadLine или ReadAll объекта TextStream. Эти методы и задачи, решаемые с их помощью, описаны в приведённой ниже таблице:

Задача Метод
Чтение указанного количества символов из файла Read
Чтение полной строки из файла (до символа конца строки, но не включая его) ReadLine
Чтение всего содержимого файла ReadAll

Пример использования данных методов см. в разделе «3.7. Пример работы с объектом FileSystemObject».

Если вы используете методы Read или ReadLine и хотите пропустить определённую часть данных, то используйте методы Scip или ScipLine. Полученный в результате работы этих методов текст может быть сохранён в строку, которую можно отобразить на экране в элементе управления, передать в качестве параметра в строковую функцию (например, в Left, Right или Mid), соединить с другой строкой и т.п.

В следующем примере показано, как открыть файл, записать в него данные, а затем прочитать их:

Sub ReadFiles
Dim fso, f1, ts, s
Const ForReading = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.CreateTextFile("c:\testreadfile.txt", True)
' Записать строку
f1.WriteLine "Hello World"
f1.WriteBlankLines(1)
f1.Close
' Прочитать содержимое файла
Set ts = fso.OpenTextFile("c:\testreadfile.txt", ForReading)
s = ts.ReadLine
MsgBox "Содержимое файла = '" & s & "'"
ts.Close
End Sub

Перемещение, копирование и удаление файлов

Объектная модель FSO имеет для каждой из операций перемещения, копирования или удаления файлов по два метода. Эти методы и задачи, решаемые с их помощью, описаны в приведённой ниже таблице:

Задача Метод
Перемещение файла File.Move или FileSystemObject.MoveFile
Копирование файла File.Copy или FileSystemObject.CopyFile
Удаление файла File.Delete или FileSystemObject.DeleteFile

Пример использования данных методов см. в разделе «3.7. Пример работы с объектом FileSystemObject».

В следующем примере создаётся текстовый файл в корневом каталоге диска С, записывается в него некоторая информация. Затем файл перемещается в директорию с именем \tmp, копируется в директорию \temp, а затем удаляются копии из обеих директорий.

Для проверки работы этого примера создайте в корневом каталоге диска С директории tmp и temp.

Sub ManipFiles
Dim fso, f1, f2, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.CreateTextFile("c:\testfile.txt", True)
' Записать строку
f1.Write ("This is a test.")
' Закрыть файл для записи
f1.Close
' Получиь дескриптор файла в корневом каталоге C:\.
Set f2 = fso.GetFile("c:\testfile.txt")
' Переместить файл в каталог \tmp
f2.Move ("c:\tmp\testfile.txt")
' Копировать файл в каталог \temp.
f2.Copy ("c:\temp\testfile.txt")
' Получить дескрипторы файлов
Set f2 = fso.GetFile("c:\tmp\testfile.txt")
Set f3 = fso.GetFile("c:\temp\testfile.txt")
' Удалить файлы
f2.Delete
f3.Delete
MsgBox "Все операции выполнены!"
End Sub

http://av-mag.ru/books/vbs/vbs-fso-files.htm

Поделиться4Четверг, 20 декабря, 2012г. 21:02:58

Автор: 6akJIAH
Администратор
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 12
Провел на форуме:
1 час 12 минут
Последний визит:
Понедельник, 11 февраля, 2013г. 00:57:09

Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add

objExcel.ActiveSheet.Name = "UserName " & Left(strDomainDN,19) & "..."
objExcel.ActiveSheet.Range("A1").Activate
objExcel.ActiveCell.Value = "яцук" 'колонка № 1
objExcel.ActiveCell.Offset(0,1).Value = "йцук1" 'колонка 2
objExcel.ActiveCell.Offset(0,2).Value = "йцук2 " 'колонка 3
objExcel.ActiveCell.Offset(0,3).Value = "йцук3р " 'колонка 4
objExcel.ActiveCell.Offset(1,0).Activate 'переход на следующую строку.

http://forum.script-coding.com/viewtopic.php?id=2915

Поделиться5Четверг, 20 декабря, 2012г. 22:04:54

Автор: 6akJIAH
Администратор
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 12
Провел на форуме:
1 час 12 минут
Последний визит:
Понедельник, 11 февраля, 2013г. 00:57:09

http://davidgrund.com/vbscriptexamples.pdf

Поделиться6Пятница, 21 декабря, 2012г. 09:14:15

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

http://www.indusoft.com/pdf/VBScript Reference.pdf

Поделиться7Пятница, 21 декабря, 2012г. 09:50:11

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Dim strDir
Dim xlApp
Dim wb
Dim fso
Dim fldr
Dim fn
Const strPath = "D:\TestFiles\"

Set fso = CreateObject("Scripting.filesystemobject")
Set xlApp = CreateObject("excel.application")
set fldr = fso.getfolder(strPath)
For each fn In fldr.files
If LCASE(Right(fn, 4)) = ".xls" then
Set wb = xlApp.Workbooks.Open(strPath & fn.name)
MyMacroFunction wb
wb.save
wb.Close
End If
Next
xlApp.Quit

Sub MyMacroFunction(wb)
'
' Macro recorded 1/31/2009 by Eric Viglotti
'
' Keyboard Shortcut: Option+Cmd+e
'
With wb.ActiveSheet.PageSetup
.PrintTitleRows = "$8:$8"
.PrintTitleColumns = ""
End With
wb.ActiveSheet.PageSetup.PrintArea = ""
With wb.ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
End With
wb.Sheets("Recent 3 Months-2").Select
With wb.ActiveSheet.PageSetup
.PrintTitleRows = "$8:$8"
.PrintTitleColumns = ""
End With
wb.ActiveSheet.PageSetup.PrintArea = ""
With wb.ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
End With
wb.Save
End Sub

Поделиться8Пятница, 21 декабря, 2012г. 10:48:24

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Dim strDir
Dim xlApp
Dim wb
Dim fso
Dim fldr
Dim fn
Const strPath = "D:\TestFiles\"

Set fso = CreateObject("Scripting.filesystemobject")
Set xlApp = CreateObject("excel.Application")
set fldr = fso.getfolder(strPath)
For each fn In fldr.files
If LCASE(Right(fn, 4)) = ".xls" then
Set wb = xlApp.Workbooks.Open(strPath & fn.name)
MyMacroFunction wb, xlApp
wb.save
wb.Close
End If
Next
xlApp.Quit

Sub MyMacroFunction(wb, xlApp)
'
' Macro recorded 1/31/2009 by Eric Viglotti
'
' Keyboard Shortcut: Option+Cmd+e
'
With wb.ActiveSheet.PageSetup
.PrintTitleRows = "$8:$8"
.PrintTitleColumns = ""
End With
wb.ActiveSheet.PageSetup.PrintArea = ""
With wb.ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = xlApp.Application.InchesToPoints(0.75)
.RightMargin = xlApp.Application.InchesToPoints(0.75)
.TopMargin = xlApp.Application.InchesToPoints(1)
.BottomMargin = xlApp.Application.InchesToPoints(1)
.HeaderMargin = xlApp.Application.InchesToPoints(0.5)
.FooterMargin = xlApp.Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
End With
wb.Sheets("Recent 3 Months-2").Select
With wb.ActiveSheet.PageSetup
.PrintTitleRows = "$8:$8"
.PrintTitleColumns = ""
End With
wb.ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = xlApp.Application.InchesToPoints(0.75)
.RightMargin = xlApp.Application.InchesToPoints(0.75)
.TopMargin = xlApp.Application.InchesToPoints(1)
.BottomMargin = xlApp.Application.InchesToPoints(1)
.HeaderMargin = xlApp.Application.InchesToPoints(0.5)
.FooterMargin = xlApp.Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
End With
wb.CheckCompatibility = False
End Sub

Поделиться9Пятница, 21 декабря, 2012г. 10:49:53

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Sub OnClick(Byval Item)
HMIRuntime.Trace Now & vbCrLf

Dim objExcel ,i

Set objExcel = CreateObject("Excel.application")
objExcel.Visible = True
objExcel.Workbooks.add

With objExcel.ActiveSheet
.Cells.Font.Italic = True
.Cells.Font.Bold = True
.Cells.Font.Size = 12
.Cells.Font.Name = "Times New Roman"
.Columns(1).ColumnWidth = 12
.Columns(2).ColumnWidth = 22
.Columns(3).ColumnWidth = 18
.Columns(4).ColumnWidth = 4
.Columns(5).ColumnWidth = 18
.Columns(7).ColumnWidth = 22
.Columns(9).ColumnWidth = 7
.Columns(11).ColumnWidth = 4
.Cells(3,1).Font.Size = 16
.Cells(3,1).Font.Italic = False
.Cells(3,1).Value ="Çàãðóæåíî:"
.Cells(26,1).Font.Size = 16
.Cells(26,1).Font.Italic = False
.Cells(26,1).Font.Underline = True
.Cells(26,1).Value ="Îòëèòî:"
.Cells(1,2).Font.Size = 20
.Cells(1,2).Font.Italic = False
.Cells(1,2).Value = "ÏËÀÂÊÀ"
.Cells(1,2).HorizontalAlignment = 4
.Cells(1,3).Font.Size = 20
.Cells(1,3).Value = "¹ 18-12"
.Cells(1,3).Borders(9).LineStyle = 1
.Cells(1,3).Borders(9).Weight = 4
.Cells(2,2).Font.Bold = False
.Cells(2,3).Font.Bold = False
.Cells(2,5).Font.Bold = False
.Cells(2,2).Font.Size = 11
.Cells(2,3).Font.Size = 11
.Cells(2,5).Font.Size = 11
.Cells(2,2).Value = "Íà÷àòà: 2.03.2012 ã"
.Cells(2,3).Value = "â 4:06"
.Cells(4,2).Value ="Ëîì À1-1"
.Cells(5,2).Value ="Ëîì À1-1à"
.Cells(6,2).Value ="Ëîì À1-2"
.Cells(7,2).Value ="Ëîì À1-1 ""Å"""
.Cells(8,2).Value ="Ïîëîñà (ìåäü)"
.Cells(9,2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
.Cells(10,2).Value ="Ñëèòîê À1-2 (øëàêîâûå)"
.Cells(11,2).Value ="Ñëèòîê Ã-2"
.Cells(12,2).Value ="Ñòðóæêà (ìåäü)"
.Cells(13,2).Value ="Êàòàíêà áðàê"
.Cells(14,2).Value ="Ïåðåõîäÿùèé îñòàòîê"
.Cells(15,2).Borders(9).LineStyle = 1
.Cells(15,3).Borders(9).LineStyle = 1
.Cells(15,4).Borders(9).LineStyle = 1
.Cells(15,2).Borders(9).Weight = 3
.Cells(15,3).Borders(9).Weight = 3
.Cells(15,4).Borders(9).Weight = 3
.Cells(16,2).Value =Chrw (&h2211) & " ="
.Cells(23,2).Value =Chrw (&h2211) & " ="
.Cells(16,2).HorizontalAlignment = 4
.Cells(23,2).HorizontalAlignment = 4
.Cells(16,3).Borders(9).LineStyle = 1
.Cells(16,3).Borders(9).Weight = 3
.Cells(23,3).Borders(9).LineStyle = 1
.Cells(23,3).Borders(9).Weight = 3
.Cells(24,2).Borders(9).LineStyle = 1
.Cells(24,3).Borders(9).LineStyle = 1
.Cells(24,4).Borders(9).LineStyle = 1
.Cells(24,2).Borders(9).Weight = 3
.Cells(24,3).Borders(9).Weight = 3
.Cells(24,4).Borders(9).Weight = 3
.Cells(18,2).Value ="Áîðíàÿ êèñëîòà"
.Cells(19,2).Value ="Ìåäü ôîñôîðèñòàÿ"
.Cells(20,2).Value ="Íàòðèÿ ïîëèôîñôàò"
.Cells(21,2).Value ="Êàðáîíàò êàëüöèÿ"
.Cells(22,2).Value ="Ñâèíåö"
.Cells(27,2).Value ="Êàòàíêà"
.Cells(28,2).Value ="Ïîëîñà (ìåäü)"
.Cells(29,2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
.Cells(30,2).Value ="Ñòðóæêà (ìåäü)"
.Cells(31,2).Value ="Êàòàíêà áðàê"
.Cells(32,2).Value =""
.Cells(33,2).Value ="Øëàêè ÷èñòûå"
.Cells(34,2).Value ="Øëàêè êèñëîòíûå"
.Cells(35,2).Value ="Øëàêè ôîñôàòíûå"
.Cells(36,2).Value ="Øëàêè ìåëîâûå"
.Cells(37,2).Borders(9).LineStyle = 1
.Cells(37,3).Borders(9).LineStyle = 1
.Cells(37,4).Borders(9).LineStyle = 1
.Cells(37,2).Borders(9).Weight = 3
.Cells(37,3).Borders(9).Weight = 3
.Cells(37,4).Borders(9).Weight = 3
.Cells(38,2).Value =Chrw (&h2211) & " ="
.Cells(38,3).Borders(9).LineStyle = 1
.Cells(38,2).HorizontalAlignment = 4
.Cells(38,3).Borders(9).Weight = 3
.Cells(40,2).Value ="Ïåðåõîäÿùèé îñòàòîê " & Chrw (&h2248)
.Cells(43,2).Value ="Óãàð"
.Cells(43,2).HorizontalAlignment = 3
.Cells(45,2).Value ="Çàìåð ãëóáèíû"
.Cells(46,2).Value ="Ðàñ÷åòíûé îñòàòîê"
.Cells(47,2).Value ="Ìàñòåð ñìåíû "
.Cells(51,2).Font.Italic = False
.Cells(51,2).Font.Bold = False
.Cells(51,2).Font.Size = 16
.Cells(51,2).Value ="Ãë.òåõíîëîã "
.Cells(2,5).Value = "Çàâåðøåíà:3.03.2011 ã â 4:45"
.Cells(13,5).Value ="çàãðóæåíî ëîìîâ ="
.Cells(22,5).Value ="çàãðóæåíî ôëþñîâ ="
.Cells(32,5).Value ="âñåãî îòëèòî ="
.Cells(36,5).Value ="âñåãî øëàêîâ ="
.Cells(43,5).Value =" èëè"
.Cells(47,3).Value ="Òðåòüÿêîâ"
.Cells(47,3).Font.Bold = False
.Cells(47,3).Font.Size = 16
.Cells(51,5).Font.Italic = False
.Cells(51,5).Font.Size = 16
.Cells(51,5).Value ="Ìàêàðîâ Â. Þ."
.Cells(23,7).Font.Underline = True
.Cells(23,7).Value ="Âñåãî çàãðóæåíî â ïå÷ü"
.Cells(40,7).Font.Underline = True
.Cells(40,7).Value ="Âñåãî ñäàíî"
.Cells(45,4).Value ="ìì"
.Cells(45,3).Borders(9).LineStyle = 1
.Cells(13,7).Value ="êã."
.Cells(13,6).Borders(9).LineStyle = 1
.Cells(22,7).Value ="êã."
.Cells(22,6).Borders(9).LineStyle = 1
.Cells(32,7).Value ="êã."
.Cells(32,6).Borders(9).LineStyle = 1
.Cells(36,7).Value ="êã."
.Cells(36,6).Borders(9).LineStyle = 1
.Cells(23,9).Value ="êã."
.Cells(23,8).Borders(9).LineStyle = 1
.Cells(40,9).Value ="êã."
.Cells(40,8).Borders(9).LineStyle = 1
.Cells(49,9).Value ="êã, èëè"
.Cells(49,8).Borders(9).LineStyle = 1
.Cells(49,10).Borders(9).LineStyle = 1
.Cells(43,8).Font.Size = 16
.Cells(43,8).Value ="%"
.Cells(49,11).Font.Size = 16
.Cells(49,11).Value ="%"
.Cells(43,6).Borders(9).LineStyle = 1
.Cells(43,7).Borders(9).LineStyle = 1
'====================================
.Range("f43:g43").Merge(True)
.Range("f45:g45").Merge(True)
.Range("f46:g46").Merge(True)
.Range("f47:g47").Merge(True)
.Range("f49:g49").Merge(True)
.Range("d50:g50").Merge(True)
.Range("d43:e43").Merge(True)
'====================================
.Cells(45,6).Value ="Âñåãî çàãðóæåíî â ïå÷ü"
.Cells(46,6).Value ="Îòëèòî"
.Cells(47,6).Value ="Ðàñ÷åòíûé îñòàòîê"
.Cells(49,6).Value ="Ðàñ÷åòíûé óãàð"
.Cells(45,6).HorizontalAlignment = 3
.Cells(46,6).HorizontalAlignment = 3
.Cells(47,6).HorizontalAlignment = 3
.Cells(49,6).HorizontalAlignment = 3
.Cells(45,8).Borders(9).LineStyle = 1
.Cells(46,8).Borders(9).LineStyle = 1
.Cells(47,8).Borders(9).LineStyle = 1
.Cells(49,8).Borders(9).LineStyle = 1
End With

'====================================

For i=4 To 46
If i=15 Or i=17 Or i=24 Or i=25 Or i=26 Or i=32 Or i=37 Or i=39 Or i=41 Or i=42 Or i=44 Or i=45 Then
i=i
Else
With objExcel
.Cells(i,4).Font.Bold = False
.Cells(i,4).Font.Italic = True
.Cells(i,4).Value ="êã."
.Cells(i,3).Borders(9).LineStyle = 1
.Cells(i,3).Borders(9).Weight = 2
End With
End If
Next
objExcel.ActiveSheet.Cells(43,4).Font.Bold = True
objExcel.ActiveSheet.Cells(43,4).Value ="êã, èëè"

'====================================

With objExcel.ActiveSheet.PageSetup
.Zoom = False
.CenterVertically = True
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
.RightMargin = 10
.leftMargin = 20
.TopMargin = 15
.HeaderMargin = 10
End With

End Sub

Поделиться10Пятница, 21 декабря, 2012г. 15:05:47

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Sub OnClick(Byval Item)
HMIRuntime.Trace Now & vbCrLf

Dim objExcel ,i, arr, m ,Marka_shihti
Dim Kol_Shihta, Nom_plav_zagr, NomPlTeg, MarkSTeg,KolA11,SumA11
Dim KolA11a,SumA11a,SumA12,KolA12,SumA11e,KolA11e,SumPol,KolPol
Dim SumSlit11,KolSlit11,SumSlit12,KolSlit12 ,SumStrug ,KolStrug
Dim SumBrak ,KolBrak,SumAll

NomPlTeg = HMIRuntime.Tags("NomPLAV").Read
MarkSTeg = HMIRuntime.Tags("MarkSTeg").Read

arr = UARead ("Sklad")

For m = 0 To (UBound(arr)-1)
If arr(m,5) = NomPlTeg Or NomPlTeg = "0" Then
'HMIRuntime.Trace "ID="& arr(m,0) & " ¹ "& arr(m,5) & " MS "& arr(m,1)& " KS "& arr(m,2) & vbCrLf

'If arr(m,1) = MarkSTeg Or MarkSTeg = "0" Then
'HMIRuntime.Trace "ID="& arr(m,0) & " ¹ "& arr(m,5) & " MS "& arr(m,1)& " KS "& arr(m,2) & vbCrLf
'End If
'=============================A1-1==================================
If arr(m,1)="A1-1" Then

KolA11 = Int (arr(m,2))
SumA11 = SumA11 + KolA11
'HMIRuntime.Trace " KolS " & KolA11 & " SumKS " & SumA11

End If
'=============================A1-1a==================================
If arr(m,1)="A1-1a" Then

KolA11a = Int (arr(m,2))
SumA11a = SumA11a + KolA11a
'HMIRuntime.Trace " KolS " & KolA11a & " SumKS " & SumA11a

End If
'=============================A1-2==================================
If arr(m,1)="A1-2" Then

KolA12 = Int (arr(m,2))
SumA12 = SumA12 + KolA12
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================A1-1e==================================
If arr(m,1)="À1-1Å" Then

KolA11e = Int (arr(m,2))
SumA11e = SumA11e + KolA11e
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÏÎËÎÑÀ==================================
If arr(m,1)="Ïîëîñà" Then

KolPol = Int (arr(m,2))
SumPol = SumPol + KolPol
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÑëèòîêÀ1-1==================================
If arr(m,1)="Ñëèòêè 1-1" Then

KolSlit11 = Int (arr(m,2))
SumSlit11 = SumSlit11 + KolSlit11
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÑëèòîêÀ1-2==================================
If arr(m,1)="Ñëèòêè 1-2" Then

KolSlit12 = Int (arr(m,2))
SumSlit12 = SumSlit12 + KolSlit12
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================Ñòðóæêà==================================
If arr(m,1)="Ñòðóæêà" Then

KolStrug = Int (arr(m,2))
SumStrug = SumStrug + KolStrug
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÊàòàíêàÁðàê==================================
If arr(m,1)="Áðàê" Then

KolBrak = Int (arr(m,2))
SumBrak = SumBrak + KolBrak
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If

End If
Marka_shihti = arr(m,1)
Kol_Shihta = arr(m,2)
Nom_plav_zagr = arr(m,5)
' Nom_Porcii_Zagr = arr(m,7)
' Zadanie_plavka= arr(m,6)
' Zadanie_plavka=Left(Zadanie_plavka,12)
' Nom_plav_Plan = arr(m,8)

HMIRuntime.Trace Now & vbCrLf

'If arr(m,5) = NomPlTeg & arr(m,1)="À1-1" Then
'KolS = arr(m,2)
'CInt(KolS)
'SumKS = Sum + KolS
'HMIRuntime.Trace " KolS "& KolS & " SumKS " & SumKS
'End If

Set objExcel = CreateObject("Excel.application")
objExcel.Visible = True
objExcel.Workbooks.add

With objExcel.ActiveSheet
.Cells.Font.Italic = True
.Cells.Font.Bold = True
.Cells.Font.Size = 12
.Cells.Font.Name = "Arial" '"Times New Roman"
.Columns(1).ColumnWidth = 12
.Columns(2).ColumnWidth = 30
.Columns(3).ColumnWidth = 10
.Columns(4).ColumnWidth = 4
.Columns(5).ColumnWidth = 18
.Columns(7).ColumnWidth = 22
.Columns(9).ColumnWidth = 7
.Columns(11).ColumnWidth = 4
.Cells(3,1).Font.Size = 16
.Cells(3,1).Font.Italic = False
.Cells(3,1).Value ="Çàãðóæåíî:"
.Cells(26,1).Font.Size = 16
.Cells(26,1).Font.Italic = False
.Cells(26,1).Font.Underline = True
.Cells(26,1).Value ="Îòëèòî:"
.Cells(1,2).Font.Size = 20
.Cells(1,2).Font.Italic = False
.Cells(1,2).Value = "ÏËÀÂÊÀ"
.Cells(1,2).HorizontalAlignment = 4
.Cells(1,3).Font.Size = 16
.Cells(1,3).Borders(9).LineStyle = 1
.Cells(1,3).Borders(9).Weight = 4
.Cells(2,2).Font.Bold = False
.Cells(2,3).Font.Bold = False
.Cells(2,5).Font.Bold = False
.Cells(2,2).Font.Size = 11
.Cells(2,3).Font.Size = 11
.Cells(2,5).Font.Size = 11
.Cells(2,2).Value = "Íà÷àòà: 2.03.2012 ã"
.Cells(2,3).Value = "â 4:06"
.Cells(4,2).Value ="Ëîì À1-1"
.Cells(5,2).Value ="Ëîì À1-1à"
.Cells(6,2).Value ="Ëîì À1-2"
.Cells(7,2).Value ="Ëîì À1-1 ""Å"""
.Cells(8,2).Value ="Ïîëîñà (ìåäü)"
.Cells(9,2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
.Cells(10,2).Value ="Ñëèòîê À1-2 (øëàêîâûå)"
.Cells(11,2).Value ="Ñëèòîê Ã-2"
.Cells(12,2).Value ="Ñòðóæêà (ìåäü)"
.Cells(13,2).Value ="Êàòàíêà áðàê"
.Cells(14,2).Value ="Ïåðåõîäÿùèé îñòàòîê"
.Cells(15,2).Borders(9).LineStyle = 1
.Cells(15,3).Borders(9).LineStyle = 1
.Cells(15,4).Borders(9).LineStyle = 1
.Cells(15,2).Borders(9).Weight = 3
.Cells(15,3).Borders(9).Weight = 3
.Cells(15,4).Borders(9).Weight = 3
.Cells(16,2).Value =Chrw (&h2211) & " ="
.Cells(23,2).Value =Chrw (&h2211) & " ="
.Cells(16,2).HorizontalAlignment = 4
.Cells(23,2).HorizontalAlignment = 4
.Cells(16,3).Borders(9).LineStyle = 1
.Cells(16,3).Borders(9).Weight = 3
.Cells(23,3).Borders(9).LineStyle = 1
.Cells(23,3).Borders(9).Weight = 3
.Cells(24,2).Borders(9).LineStyle = 1
.Cells(24,3).Borders(9).LineStyle = 1
.Cells(24,4).Borders(9).LineStyle = 1
.Cells(24,2).Borders(9).Weight = 3
.Cells(24,3).Borders(9).Weight = 3
.Cells(24,4).Borders(9).Weight = 3
.Cells(18,2).Value ="Áîðíàÿ êèñëîòà"
.Cells(19,2).Value ="Ìåäü ôîñôîðèñòàÿ"
.Cells(20,2).Value ="Íàòðèÿ ïîëèôîñôàò"
.Cells(21,2).Value ="Êàðáîíàò êàëüöèÿ"
.Cells(22,2).Value ="Ñâèíåö"
.Cells(27,2).Value ="Êàòàíêà"
.Cells(28,2).Value ="Ïîëîñà (ìåäü)"
.Cells(29,2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
.Cells(30,2).Value ="Ñòðóæêà (ìåäü)"
.Cells(31,2).Value ="Êàòàíêà áðàê"
.Cells(32,2).Value =""
.Cells(33,2).Value ="Øëàêè ÷èñòûå"
.Cells(34,2).Value ="Øëàêè êèñëîòíûå"
.Cells(35,2).Value ="Øëàêè ôîñôàòíûå"
.Cells(36,2).Value ="Øëàêè ìåëîâûå"
.Cells(37,2).Borders(9).LineStyle = 1
.Cells(37,3).Borders(9).LineStyle = 1
.Cells(37,4).Borders(9).LineStyle = 1
.Cells(37,2).Borders(9).Weight = 3
.Cells(37,3).Borders(9).Weight = 3
.Cells(37,4).Borders(9).Weight = 3
.Cells(38,2).Value =Chrw (&h2211) & " ="
.Cells(38,3).Borders(9).LineStyle = 1
.Cells(38,2).HorizontalAlignment = 4
.Cells(38,3).Borders(9).Weight = 3
.Cells(40,2).Value ="Ïåðåõîäÿùèé îñòàòîê " & Chrw (&h2248)
.Cells(43,2).Value ="Óãàð"
.Cells(43,2).HorizontalAlignment = 3
.Cells(45,2).Value ="Çàìåð ãëóáèíû"
.Cells(46,2).Value ="Ðàñ÷åòíûé îñòàòîê"
.Cells(47,2).Value ="Ìàñòåð ñìåíû "
.Cells(51,2).Font.Italic = False
.Cells(51,2).Font.Bold = False
.Cells(51,2).Font.Size = 16
.Cells(51,2).Value ="Ãë.òåõíîëîã "
.Cells(2,5).Value = "Çàâåðøåíà:3.03.2011 ã â 4:45"
.Cells(13,5).Font.Size = 10
.Cells(22,5).Font.Size = 10
.Cells(32,5).Font.Size = 10
.Cells(36,5).Font.Size = 10
.Cells(13,5).Value ="çàãðóæåíî ëîìîâ ="
.Cells(22,5).Value ="çàãðóæåíî ôëþñîâ ="
.Cells(32,5).Value ="âñåãî îòëèòî ="
.Cells(36,5).Value ="âñåãî øëàêîâ ="
.Cells(43,5).Value =" èëè"
.Cells(47,3).Value ="Òðåòüÿêîâ"
.Cells(47,3).Font.Bold = False
.Cells(47,3).Font.Size = 16
.Cells(47,3).Borders(9).LineStyle = 1
.Cells(51,5).Font.Italic = False
.Cells(51,5).Font.Size = 16
.Cells(51,5).Value ="Ìàêàðîâ Â. Þ."
.Cells(23,7).Font.Underline = True
.Cells(23,7).Value ="Âñåãî çàãðóæåíî"
.Cells(40,7).Font.Underline = True
.Cells(40,7).Value ="Âñåãî ñäàíî"
.Cells(45,4).Value ="ìì"
.Cells(45,3).Borders(9).LineStyle = 1
.Cells(13,7).Value ="êã."
.Cells(13,6).Borders(9).LineStyle = 1
.Cells(22,7).Value ="êã."
.Cells(22,6).Borders(9).LineStyle = 1
.Cells(32,7).Value ="êã."
.Cells(32,6).Borders(9).LineStyle = 1
.Cells(36,7).Value ="êã."
.Cells(36,6).Borders(9).LineStyle = 1
.Cells(23,9).Value ="êã."
.Cells(23,8).Borders(9).LineStyle = 1
.Cells(40,9).Value ="êã."
.Cells(40,8).Borders(9).LineStyle = 1
.Cells(49,9).Value ="êã, èëè"
.Cells(49,8).Borders(9).LineStyle = 1
.Cells(49,10).Borders(9).LineStyle = 1
.Cells(43,8).Font.Size = 16
.Cells(43,8).Value ="%"
.Cells(49,11).Font.Size = 16
.Cells(49,11).Value ="%"
.Cells(43,6).Borders(9).LineStyle = 1
.Cells(43,7).Borders(9).LineStyle = 1
'====================================
.Range("f43:g43").Merge(True)
.Range("f45:g45").Merge(True)
.Range("f46:g46").Merge(True)
.Range("f47:g47").Merge(True)
.Range("f49:g49").Merge(True)
.Range("d50:g50").Merge(True)
.Range("d43:e43").Merge(True)
'====================================
.Cells(45,6).Value ="Âñåãî çàãðóæåíî â ïå÷ü"
.Cells(46,6).Value ="Îòëèòî"
.Cells(47,6).Value ="Ðàñ÷åòíûé îñòàòîê"
.Cells(49,6).Value ="Ðàñ÷åòíûé óãàð"
.Cells(45,6).HorizontalAlignment = 3
.Cells(46,6).HorizontalAlignment = 3
.Cells(47,6).HorizontalAlignment = 3
.Cells(49,6).HorizontalAlignment = 3
.Cells(45,8).Borders(9).LineStyle = 1
.Cells(46,8).Borders(9).LineStyle = 1
.Cells(47,8).Borders(9).LineStyle = 1
.Cells(49,8).Borders(9).LineStyle = 1
End With

'====================================

For i=4 To 46
If i=15 Or i=17 Or i=24 Or i=25 Or i=26 Or i=32 Or i=37 Or i=39 Or i=41 Or i=42 Or i=44 Or i=45 Then
i=i
Else
With objExcel
.Cells(i,4).Font.Bold = False
.Cells(i,4).Font.Italic = True
.Cells(i,4).Value ="êã."
.Cells(i,3).Borders(9).LineStyle = 1
.Cells(i,3).Borders(9).Weight = 2
End With
End If
Next
objExcel.ActiveSheet.Cells(43,4).Font.Bold = True
objExcel.ActiveSheet.Cells(43,4).Value ="êã, èëè"

'====================================
With objExcel.ActiveSheet
.Cells(1,3).Value = "¹ " & NomPlTeg

.Cells(4,3).Value = SumA11
.Cells(5,3).Value = SumA11a
.Cells(6,3).Value = SumA12
.Cells(7,3).Value = SumA11e
.Cells(8,3).Value = SumPol
.Cells(9,3).Value = SumSlit11
.Cells(10,3).Value = SumSlit12
'.Cells(11,3).Value = SumSlitG
.Cells(12,3).Value = SumStrug
.Cells(13,3).Value = SumBrak
.Cells(13,6).Value = SumAll

End With

'====================================

With objExcel.ActiveSheet.PageSetup
.Zoom = False
.CenterVertically = True
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
.RightMargin = 10
.leftMargin = 20
.TopMargin = 15
.HeaderMargin = 10
End With

End Sub

Поделиться11Пятница, 21 декабря, 2012г. 15:07:37

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Time
time+0:30> TimePr and time+0:30< TimeRash
Cdate()

Поделиться12Суббота, 22 декабря, 2012г. 09:56:13

Автор: 6akJIAH
Администратор
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 12
Провел на форуме:
1 час 12 минут
Последний визит:
Понедельник, 11 февраля, 2013г. 00:57:09

Пример использования функции CDate:
Dim mydate, myshortdate ' Обьявляем переменные mydate и myshortdate
mydate = "14 Января 2010" ' Присваеваем дату
myshortdate = CDate(mydate) ' Преобразовываем в формат Date получаем "14.01.2010".
MsgBox(myshortdate) ' Выводим результат
mydate = "14,1,2010" ' Присваеваем дату
myshortdate = CDate(mydate) ' Преобразовываем в формат Date получаем "14.01.2010".
MsgBox(myshortdate) ' Выводим результат
mydate = "Января 14, 2010" ' Присваеваем дату
myshortdate = CDate(mydate) ' Преобразовываем в формат Date получаем "14.01.2010".
MsgBox(myshortdate) ' Выводим результат

http://xod.in.ua/article/read/CDate_Function.html

Функции
http://xod.in.ua/article/view/function.html

Поделиться13Понедельник, 24 декабря, 2012г. 05:01:07

Автор: 6akJIAH
Администратор
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 12
Провел на форуме:
1 час 12 минут
Последний визит:
Понедельник, 11 февраля, 2013г. 00:57:09

Sub OnClick(Byval Item)
HMIRuntime.Trace Now & vbCrLf

Dim str,col
Dim objExcel ,i, arr, m ,Marka_shihti
Dim Kol_Shihta, Nom_plav_zagr, NomPlTeg, MarkSTeg,KolA11,SumA11
Dim KolA11a,SumA11a,SumA12,KolA12,SumA11e,KolA11e,SumPol,KolPol
Dim SumSlit11,KolSlit11,SumSlit12,KolSlit12 ,SumStrug ,KolStrug
Dim SumBrak ,KolBrak,SumAll

NomPlTeg = HMIRuntime.Tags("NomPLAV").Read
MarkSTeg = HMIRuntime.Tags("MarkSTeg").Read

arr = UARead ("Sklad")

For m = 0 To (UBound(arr)-1)
If arr(m,5) = NomPlTeg Or NomPlTeg = "0" Then
'HMIRuntime.Trace "ID="& arr(m,0) & " ¹ "& arr(m,5) & " MS "& arr(m,1)& " KS "& arr(m,2) & vbCrLf

'If arr(m,1) = MarkSTeg Or MarkSTeg = "0" Then
'HMIRuntime.Trace "ID="& arr(m,0) & " ¹ "& arr(m,5) & " MS "& arr(m,1)& " KS "& arr(m,2) & vbCrLf
'End If
'=============================A1-1==================================
If arr(m,1)="A1-1" Then

KolA11 = Int (arr(m,2))
SumA11 = SumA11 + 1
SumA11 = SumA11 + KolA11
SumA11 = SumA11 - 1
'HMIRuntime.Trace " KolS " & KolA11 & " SumKS " & SumA11

End If
'=============================A1-1a==================================
If arr(m,1)="A1-1a" Then
SumA11a = SumA11a + 1
KolA11a = Int (arr(m,2))
SumA11a = SumA11a + KolA11a
SumA11a = SumA11a - 1
'HMIRuntime.Trace " KolS " & KolA11a & " SumKS " & SumA11a

End If
'=============================A1-2==================================
If arr(m,1)="A1-2" Then
SumA12 = SumA12 + 1
KolA12 = Int (arr(m,2))
SumA12 = SumA12 + KolA12
SumA12 = SumA12 - 1
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================A1-1e==================================
If arr(m,1)="À1-1Å" Then
SumA11e = SumA11e + 1
KolA11e = Int (arr(m,2))
SumA11e = SumA11e + KolA11e
SumA11e = SumA11e - 1
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÏÎËÎÑÀ==================================
If arr(m,1)="Ïîëîñà" Then
SumPol = SumPol + 1
KolPol = Int (arr(m,2))
SumPol = SumPol + KolPol
SumPol = SumPol - 1
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÑëèòîêÀ1-1==================================
If arr(m,1)="Ñëèòêè 1-1" Then
SumSlit11 = SumSlit11 + 1
KolSlit11 = Int (arr(m,2))
SumSlit11 = SumSlit11 + KolSlit11
SumSlit11 = SumSlit11 - 1
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÑëèòîêÀ1-2==================================
If arr(m,1)="Ñëèòêè 1-2" Then
SumSlit12 = SumSlit12 + 1
KolSlit12 = Int (arr(m,2))
SumSlit12 = SumSlit12 + KolSlit12
SumSlit12 = SumSlit12 - 1
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================Ñòðóæêà==================================
If arr(m,1)="Ñòðóæêà" Then
SumStrug = SumStrug + 1
KolStrug = Int (arr(m,2))
SumStrug = SumStrug + KolStrug
SumStrug = SumStrug - 1
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÊàòàíêàÁðàê==================================
If arr(m,1)="Áðàê" Then
SumBrak = SumBrak + 1
KolBrak = Int (arr(m,2))
SumBrak = SumBrak + KolBrak
SumBrak = SumBrak - 1
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If

'=================================DATE============================================
For m = 0 To (UBound(arr)-1)
Time =
If (Time + 0:30) > TimePr & (Time + 0:30) < TimeRash Then

End If
Cdate()

End If
Marka_shihti = arr(m,1)
Kol_Shihta = arr(m,2)
Nom_plav_zagr = arr(m,5)
' Nom_Porcii_Zagr = arr(m,7)
' Zadanie_plavka= arr(m,6)
' Zadanie_plavka=Left(Zadanie_plavka,12)
' Nom_plav_Plan = arr(m,8)

'If arr(m,5) = NomPlTeg & arr(m,1)="À1-1" Then
'KolS = arr(m,2)
'CInt(KolS)
'SumKS = Sum + KolS
'HMIRuntime.Trace " KolS "& KolS & " SumKS " & SumKS
'End If

Set objExcel = CreateObject("Excel.application")
objExcel.Visible = True
objExcel.Workbooks.add

With objExcel.ActiveSheet
.Cells.Font.Italic = True
.Cells.Font.Bold = True
.Cells.Font.Size = 12
.Cells.Font.Name = "Arial" '"Times New Roman"
.Columns(col+1).ColumnWidth = 12
.Columns(col+2).ColumnWidth = 30
.Columns(col+3).ColumnWidth = 10
.Columns(col+4).ColumnWidth = 4
.Columns(col+5).ColumnWidth = 18
.Columns(col+7).ColumnWidth = 22
.Columns(col+9).ColumnWidth = 7
.Columns(col+11).ColumnWidth = 4
.Cells(str+3,col+1).Font.Size = 16
.Cells(str+3,col+1).Font.Italic = False
.Cells(str+3,col+1).Value ="Çàãðóæåíî:"
.Cells(str+26,col+1).Font.Size = 16
.Cells(str+26,col+1).Font.Italic = False
.Cells(str+26,col+1).Font.Underline = True
.Cells(str+26,col+1).Value ="Îòëèòî:"
.Cells(str+1,col+2).Font.Size = 20
.Cells(str+1,col+2).Font.Italic = False
.Cells(str+1,col+2).Value = "ÏËÀÂÊÀ"
.Cells(str+1,col+2).HorizontalAlignment = 4
.Cells(str+1,col+3).Font.Size = 16
.Cells(str+1,col+3).Borders(9).LineStyle = 1
.Cells(str+1,col+3).Borders(9).Weight = 4
.Cells(str+2,col+2).Font.Bold = False
.Cells(str+2,col+3).Font.Bold = False
.Cells(str+2,col+5).Font.Bold = False
.Cells(str+2,col+2).Font.Size = 11
.Cells(str+2,col+3).Font.Size = 11
.Cells(str+2,col+5).Font.Size = 11
.Cells(str+2,col+2).Value = "Íà÷àòà: 2.03.2012 ã"
.Cells(str+2,col+3).Value = "â 4:06"
.Cells(str+4,col+2).Value ="Ëîì À1-1"
.Cells(str+5,col+2).Value ="Ëîì À1-1à"
.Cells(str+6,col+2).Value ="Ëîì À1-2"
.Cells(str+7,col+2).Value ="Ëîì À1-1 ""Å"""
.Cells(str+8,col+2).Value ="Ïîëîñà (ìåäü)"
.Cells(str+9,col+2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
.Cells(str+10,col+2).Value ="Ñëèòîê À1-2 (øëàêîâûå)"
.Cells(str+11,col+2).Value ="Ñëèòîê Ã-2"
.Cells(str+12,col+2).Value ="Ñòðóæêà (ìåäü)"
.Cells(str+13,col+2).Value ="Êàòàíêà áðàê"
.Cells(str+14,col+2).Value ="Ïåðåõîäÿùèé îñòàòîê"
.Cells(str+15,col+2).Borders(9).LineStyle = 1
.Cells(str+15,col+3).Borders(9).LineStyle = 1
.Cells(str+15,col+4).Borders(9).LineStyle = 1
.Cells(str+15,col+2).Borders(9).Weight = 3
.Cells(str+15,col+3).Borders(9).Weight = 3
.Cells(str+15,col+4).Borders(9).Weight = 3
.Cells(str+16,col+2).Value =Chrw (&h2211) & " ="
.Cells(str+23,col+2).Value =Chrw (&h2211) & " ="
.Cells(str+16,col+2).HorizontalAlignment = 4
.Cells(str+23,col+2).HorizontalAlignment = 4
.Cells(str+16,col+3).Borders(9).LineStyle = 1
.Cells(str+16,col+3).Borders(9).Weight = 3
.Cells(str+23,col+3).Borders(9).LineStyle = 1
.Cells(str+23,col+3).Borders(9).Weight = 3
.Cells(str+24,col+2).Borders(9).LineStyle = 1
.Cells(str+24,col+3).Borders(9).LineStyle = 1
.Cells(str+24,col+4).Borders(9).LineStyle = 1
.Cells(str+24,col+2).Borders(9).Weight = 3
.Cells(str+24,col+3).Borders(9).Weight = 3
.Cells(str+24,col+4).Borders(9).Weight = 3
.Cells(str+18,col+2).Value ="Áîðíàÿ êèñëîòà"
.Cells(str+19,col+2).Value ="Ìåäü ôîñôîðèñòàÿ"
.Cells(str+20,col+2).Value ="Íàòðèÿ ïîëèôîñôàò"
.Cells(str+21,col+2).Value ="Êàðáîíàò êàëüöèÿ"
.Cells(str+22,col+2).Value ="Ñâèíåö"
.Cells(str+27,col+2).Value ="Êàòàíêà"
.Cells(str+28,col+2).Value ="Ïîëîñà (ìåäü)"
.Cells(str+29,col+2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
.Cells(str+30,col+2).Value ="Ñòðóæêà (ìåäü)"
.Cells(str+31,col+2).Value ="Êàòàíêà áðàê"
.Cells(str+32,col+2).Value =""
.Cells(str+33,col+2).Value ="Øëàêè ÷èñòûå"
.Cells(str+34,col+2).Value ="Øëàêè êèñëîòíûå"
.Cells(str+35,col+2).Value ="Øëàêè ôîñôàòíûå"
.Cells(str+36,col+2).Value ="Øëàêè ìåëîâûå"
.Cells(str+37,col+2).Borders(9).LineStyle = 1
.Cells(str+37,col+3).Borders(9).LineStyle = 1
.Cells(str+37,col+4).Borders(9).LineStyle = 1
.Cells(str+37,col+2).Borders(9).Weight = 3
.Cells(str+37,col+3).Borders(9).Weight = 3
.Cells(str+37,col+4).Borders(9).Weight = 3
.Cells(str+38,col+2).Value =Chrw (&h2211) & " ="
.Cells(str+38,col+3).Borders(9).LineStyle = 1
.Cells(str+38,col+2).HorizontalAlignment = 4
.Cells(str+38,col+3).Borders(9).Weight = 3
.Cells(str+40,col+2).Value ="Ïåðåõîäÿùèé îñòàòîê " & Chrw (&h2248)
.Cells(str+43,col+2).Value ="Óãàð"
.Cells(str+43,col+2).HorizontalAlignment = 3
.Cells(str+45,col+2).Value ="Çàìåð ãëóáèíû"
.Cells(str+46,col+2).Value ="Ðàñ÷åòíûé îñòàòîê"
.Cells(str+47,col+2).Value ="Ìàñòåð ñìåíû "
.Cells(str+51,col+2).Font.Italic = False
.Cells(str+51,col+2).Font.Bold = False
.Cells(str+51,col+2).Font.Size = 16
.Cells(str+51,col+2).Value ="Ãë.òåõíîëîã "
.Cells(str+2,col+5).Value = "Çàâåðøåíà:3.03.2011 ã â 4:45"
.Cells(str+13,col+5).Font.Size = 10
.Cells(str+22,col+5).Font.Size = 10
.Cells(str+32,col+5).Font.Size = 10
.Cells(str+36,col+5).Font.Size = 10
.Cells(str+13,col+5).Value ="çàãðóæåíî ëîìîâ ="
.Cells(str+22,col+5).Value ="çàãðóæåíî ôëþñîâ ="
.Cells(str+32,col+5).Value ="âñåãî îòëèòî ="
.Cells(str+36,col+5).Value ="âñåãî øëàêîâ ="
.Cells(str+43,col+5).Value =" èëè"
.Cells(str+47,col+3).Value ="Òðåòüÿêîâ"
.Cells(str+47,col+3).Font.Bold = False
.Cells(str+47,col+3).Font.Size = 16
.Cells(str+47,col+3).Borders(9).LineStyle = 1
.Cells(str+51,col+5).Font.Italic = False
.Cells(str+51,col+5).Font.Size = 16
.Cells(str+51,col+5).Value ="Ìàêàðîâ Â. Þ."
.Cells(str+23,col+7).Font.Underline = True
.Cells(str+23,col+7).Value ="Âñåãî çàãðóæåíî"
.Cells(str+40,col+7).Font.Underline = True
.Cells(str+40,col+7).Value ="Âñåãî ñäàíî"
.Cells(str+45,col+4).Value ="ìì"
.Cells(str+45,col+3).Borders(9).LineStyle = 1
.Cells(str+13,col+7).Value ="êã."
.Cells(str+13,col+6).Borders(9).LineStyle = 1
.Cells(str+22,col+7).Value ="êã."
.Cells(str+22,col+6).Borders(9).LineStyle = 1
.Cells(str+32,col+7).Value ="êã."
.Cells(str+32,col+6).Borders(9).LineStyle = 1
.Cells(str+36,col+7).Value ="êã."
.Cells(str+36,col+6).Borders(9).LineStyle = 1
.Cells(str+23,col+9).Value ="êã."
.Cells(str+23,col+8).Borders(9).LineStyle = 1
.Cells(str+40,col+9).Value ="êã."
.Cells(str+40,col+8).Borders(9).LineStyle = 1
.Cells(str+49,col+9).Value ="êã, èëè"
.Cells(str+49,col+8).Borders(9).LineStyle = 1
.Cells(str+49,col+10).Borders(9).LineStyle = 1
.Cells(str+43,col+8).Font.Size = 16
.Cells(str+43,col+8).Value ="%"
.Cells(str+49,col+11).Font.Size = 16
.Cells(str+49,col+11).Value ="%"
.Cells(str+43,col+6).Borders(9).LineStyle = 1
.Cells(str+43,col+7).Borders(9).LineStyle = 1
'====================================
.Range("f43:g43").Merge(True)
.Range("f45:g45").Merge(True)
.Range("f46:g46").Merge(True)
.Range("f47:g47").Merge(True)
.Range("f49:g49").Merge(True)
.Range("d50:g50").Merge(True)
.Range("d43:e43").Merge(True)
'====================================
.Cells(str+45,col+6).Value ="Âñåãî çàãðóæåíî â ïå÷ü"
.Cells(str+46,col+6).Value ="Îòëèòî"
.Cells(str+47,col+6).Value ="Ðàñ÷åòíûé îñòàòîê"
.Cells(str+49,col+6).Value ="Ðàñ÷åòíûé óãàð"
.Cells(str+45,col+6).HorizontalAlignment = 3
.Cells(str+46,col+6).HorizontalAlignment = 3
.Cells(str+47,col+6).HorizontalAlignment = 3
.Cells(str+49,col+6).HorizontalAlignment = 3
.Cells(str+45,col+8).Borders(9).LineStyle = 1
.Cells(str+46,col+8).Borders(9).LineStyle = 1
.Cells(str+47,col+8).Borders(9).LineStyle = 1
.Cells(str+49,col+8).Borders(9).LineStyle = 1
End With

'====================================

For i=4 To 46
If i=15 Or i=17 Or i=24 Or i=25 Or i=26 Or i=32 Or i=37 Or i=39 Or i=41 Or i=42 Or i=44 Or i=45 Then

Else
With objExcel
.Cells(i,4).Font.Bold = False
.Cells(i,4).Font.Italic = True
.Cells(i,4).Value ="êã."
.Cells(i,3).Borders(9).LineStyle = 1
.Cells(i,3).Borders(9).Weight = 2
End With
End If
Next
objExcel.ActiveSheet.Cells(43,4).Font.Bold = True
objExcel.ActiveSheet.Cells(43,4).Value ="êã, èëè"

'====================================
With objExcel.ActiveSheet

.Cells(str+1,col+3).Value = "¹ " & NomPlTeg
.Cells(str+4,col+3).Value = SumA11
.Cells(str+5,col+3).Value = SumA11a
.Cells(str+6,col+3).Value = SumA12
.Cells(str+7,col+3).Value = SumA11e
.Cells(str+8,col+3).Value = SumPol
.Cells(str+9,col+3).Value = SumSlit11
.Cells(str+10,col+3).Value = SumSlit12
.Cells(str+12,col+3).Value = SumStrug
.Cells(str+13,col+3).Value = SumBrak
.Cells(str+13,col+6).Value = SumAll

End With

'====================================

With objExcel.ActiveSheet.PageSetup
.Zoom = False
.CenterVertically = True
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
.RightMargin = 10
.leftMargin = 20
.TopMargin = 15
.HeaderMargin = 10
End With

End Sub

Поделиться14Четверг, 27 декабря, 2012г. 15:03:09

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Sub OnClick(Byval Item)
'HMIRuntime.Trace Now & vbCrLf

Dim objExcel ,i, m ,m2,m3,m4,Marka_shihti,k , arrPodg , arrSklad
Dim Kol_Shihta, Nom_plav_zagr, NomPlTeg, MarkSTeg,KolA11,SumA11
Dim KolA11a,SumA11a,SumA12,KolA12,SumA11e,KolA11e,SumPol,KolPol
Dim SumSlit11,KolSlit11,SumSlit12,KolSlit12 ,SumStrug ,KolStrug
Dim SumBrak ,KolBrak,SumAllSklad,SDay,SMonth ,SYear,SHour,SMinute
Dim TimeStPod,TimeFinPod, TimePrihod, TimeRashod, PodgUroven
Dim FDay,FMonth ,FYear,FHour,FMinute,VerifiTimeFin,VerifiTimeStart
Dim arrRafinir,BornAcid,SumBorn,GMF1,GMF2,SumGMF,Soda1,Soda2,SumSoda
Dim SumAllRafinir,SumAllZagruz
Dim arrVosst,BornAcidShlak,SumBornShlak,GMF1Shlak,GMF2Shlak,SumGMFShlak
Dim Soda1Shlak,Soda2Shlak,SumSodaShlak,SumAllShlak
Dim PutSaveFile, NameFile, DataPlavk ,MsgX,MsgX2,fso,Save1
Dim strok,stolb

'Set rst = CreateObject("ADODB.Recordset")
'con = "Provider = SQLOLEDB;Initial Catalog = " & "S01_@DatasourceNameRT" & ";Data Source = S01\WinCC;Integrated Security = SSPI"
'

NomPlTeg = HMIRuntime.Tags("NomPLAV").Read
MarkSTeg = HMIRuntime.Tags("MarkSTeg").Read

arrSklad = UARead ("Sklad")
arrPodg = UARead ("Podgotovka")
arrRafinir = UARead ("Rafinirovanie")
arrVosst = UARead ("Vosstanovlenie")

'================================================SKLAD=========================================
For m = 0 To (UBound(arrSklad)-1)
If arrSklad(m,5) = NomPlTeg Or NomPlTeg = "0" Then

'=============================A1-1==================================
If arrSklad(m,1)="A1-1" Then

KolA11 = Int (arrSklad(m,2))
SumA11 = SumA11 + KolA11
'HMIRuntime.Trace " KolS " & KolA11 & " SumKS " & SumA11

End If
'=============================A1-1a==================================
If arrSklad(m,1)="A1-1a" Then

KolA11a = Int (arrSklad(m,2))
SumA11a = SumA11a + KolA11a
'HMIRuntime.Trace " KolS " & KolA11a & " SumKS " & SumA11a

End If
'=============================A1-2==================================
If arrSklad(m,1)="A1-2" Then

KolA12 = Int (arrSklad(m,2))
SumA12 = SumA12 + KolA12
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================A1-1e==================================
If arrSklad(m,1)="À1-1Å" Then

KolA11e = Int (arrSklad(m,2))
SumA11e = SumA11e + KolA11e
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÏÎËÎÑÀ==================================
If arrSklad(m,1)="Ïîëîñà" Then

KolPol = Int (arrSklad(m,2))
SumPol = SumPol + KolPol
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÑëèòîêÀ1-1==================================
If arrSklad(m,1)="Ñëèòêè 1-1" Then

KolSlit11 = Int (arrSklad(m,2))
SumSlit11 = SumSlit11 + KolSlit11
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÑëèòîêÀ1-2==================================
If arrSklad(m,1)="Ñëèòêè 1-2" Then

KolSlit12 = Int (arrSklad(m,2))
SumSlit12 = SumSlit12 + KolSlit12
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================Ñòðóæêà==================================
If arrSklad(m,1)="Ñòðóæêà" Then

KolStrug = Int (arrSklad(m,2))
SumStrug = SumStrug + KolStrug
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÊàòàíêàÁðàê==================================
If arrSklad(m,1)="Áðàê" Then
SumBrak = Int (SumBrak)
KolBrak = Int (arrSklad(m,2))
SumBrak = SumBrak + KolBrak

'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If

End If
Marka_shihti = arrSklad(m,1)
Kol_Shihta = arrSklad(m,2)
Nom_plav_zagr = arrSklad(m,5)
TimePrihod = arrSklad(m,3)
TimeRashod = arrSklad(m,4)
' Nom_Porcii_Zagr = arr(m,7)
' Zadanie_plavka= arr(m,6)
' Zadanie_plavka=Left(Zadanie_plavka,12)
' Nom_plav_Plan = arr(m,8)

'=========================================RAFINIROVANIE=======================================

For m4 = 0 To (UBound(arrRafinir)-1)
HMIRuntime.Trace arrRafinir(m4,1)& vbCrLf
If arrRafinir(m4,1) = NomPlTeg Then

'===========BORN====================
BornAcid = Int(arrRafinir(m4,79))
SumBorn = SumBorn + BornAcid
'============GMF====================
GMF1 = Int(arrRafinir(m4,80))
GMF2 = Int(arrRafinir(m4,81))
SumGMF = SumGMF + (GMF1 + GMF2)
'=============SODA===================
Soda1 = Int(arrRafinir(m4,82))
Soda2 = Int(arrRafinir(m4,83))
SumSoda = SumSoda + (Soda1 + Soda2)
'====================================
HMIRuntime.Trace vbCrLf & m4 & vbCrLf & m3 & vbCrLf & BornAcid& vbCrLf & SumBorn& vbCrLf & GMF1& vbCrLf & GMF2 & vbCrLf & Soda1 & vbCrLf
Exit For
End If
Next
SumAllRafinir = SumBorn + SumGMF + SumSoda
SumAllZagruz = SumAllRafinir + SumAllSklad

'=======================SHLAK===Vosstanovlenie==============================================================

For m3 = 0 To (UBound(arrVosst)-1)
'HMIRuntime.Trace arrVosst(m3,1)& vbCrLf
If arrVosst(m3,1) = NomPlTeg Then

'===========BORN==Shlak==================
BornAcidShlak = Int(arrVosst(m3,76))
SumBornShlak = SumBornShlak + BornAcidShlak
'============GMF==Shlak==================
GMF1Shlak = Int(arrVosst(m3,77))
GMF2Shlak = Int(arrVosst(m3,78))
SumGMFShlak = SumGMFShlak + (GMF1Shlak + GMF2Shlak)
'=============SODA==Shlak=================
Soda1Shlak = Int(arrVosst(m3,79))
Soda2Shlak = Int(arrVosst(m3,80))
SumSodaShlak = SumSodaShlak + (Soda1Shlak + Soda2Shlak)
'====================================
'HMIRuntime.Trace vbCrLf & m4 & vbCrLf & m3 & vbCrLf & BornAcid& vbCrLf & SumBorn& vbCrLf & GMF1& vbCrLf & GMF2 & vbCrLf & Soda1 & vbCrLf
Exit For
End If
Next

SumAllShlak = SumBornShlak + SumGMFShlak + SumSodaShlak

'====================================Vremya plavki===================================

For m2 = 0 To (UBound(arrPodg)-1)

If arrPodg(m2,45)= NomPlTeg Then

TimeStPod = arrPodg(m2,49)
TimeFinPod = arrPodg(m2+1,49)
PodgUroven = arrPodg(m2+1,47)
TimeStPod = CDate(TimeStPod)
SDay = Day(TimeStPod)
SMonth = Month(TimeStPod)
SYear = Year(TimeStPod)
SHour = Hour(TimeStPod)
SMinute = Minute(TimeStPod)

TimeFinPod = CDate(TimeFinPod)
FDay = Day(TimeFinPod)
FMonth = Month(TimeFinPod)
FYear = Year(TimeFinPod)
FHour = Hour(TimeFinPod)
FMinute = Minute(TimeFinPod)

VerifiTimeStart = Int(SYear)
VerifiTimeFin = Int(FYear)

Exit For

End If
Next

'===========================PROVERKA NA NALICHIE FILE.xls=============================================================

Save1 = False
PutSaveFile = HMIRuntime.Tags("@UA_Plavka_Otchyet_Put").Read
DataPlavk = SDay & "." & SMonth & "." & SYear & "ã"
NameFile = "Ïëàâêà ¹ " & NomPlTeg & "_" & DataPlavk

HMIRuntime.Trace "__________" & PutSaveFile & NameFile & vbCrLf

Set fso= CreateObject("Scripting.FileSystemObject")

With fso
If .FileExists(PutSaveFile & NameFile & ".xls" ) Then
Save1 = True
MsgX2 = MsgBox ( NameFile &" Òàêîé ôàéë óæå ñóùåñòâóåò. Çàìåíèòü? " ,4,NameFile)

If MsgX2 = 6 Then
.DeleteFile PutSaveFile & NameFile & ".xls", True
HMIRuntime.Trace " ÔÀÉË ÓÄÀË¨Í "
Save1 = False
   Else
   Save1 = True
End If

End If

End With

'=========================CREATE EXCEL=======================================================

If save1 = False Then

Set objExcel = CreateObject("Excel.application")
objExcel.Visible = False
objExcel.Workbooks.add
strok = 0
stolb = 0

With objExcel.ActiveSheet
.Cells.Font.Italic = True
.Cells.Font.Bold = True
.Cells.Font.Size = 12
.Cells.Font.Name = "Arial" '"Times New Roman"
.Columns(stolb+1).ColumnWidth = 12
.Columns(stolb+2).ColumnWidth = 30
.Columns(stolb+3).ColumnWidth = 10
.Columns(stolb+4).ColumnWidth = 4
.Columns(stolb+5).ColumnWidth = 18
.Columns(stolb+7).ColumnWidth = 22
.Columns(stolb+9).ColumnWidth = 7
.Columns(stolb+11).ColumnWidth = 4
.Cells(strok+3,stolb+1).Font.Size = 16
.Cells(strok+3,stolb+1).Font.Italic = False
.Cells(strok+3,stolb+1).Value ="Çàãðóæåíî:"
.Cells(strok+26,stolb+1).Font.Size = 16
.Cells(strok+26,stolb+1).Font.Italic = False
.Cells(strok+26,stolb+1).Font.Underline = True
.Cells(strok+26,stolb+1).Value ="Îòëèòî:"
.Cells(strok+1,stolb+2).Font.Size = 20
.Cells(strok+1,stolb+2).Font.Italic = False
.Cells(strok+1,stolb+2).Value = "ÏËÀÂÊÀ"
.Cells(strok+1,stolb+2).HorizontalAlignment = 4
.Cells(strok+1,stolb+3).Font.Size = 16
.Cells(strok+1,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+1,stolb+3).Borders(9).Weight = 4
.Cells(strok+2,stolb+2).Font.Bold = False
.Cells(strok+2,stolb+3).Font.Bold = False
.Cells(strok+2,stolb+5).Font.Bold = False
.Cells(strok+2,stolb+2).Font.Size = 11
.Cells(strok+2,stolb+3).Font.Size = 11
.Cells(strok+2,stolb+5).Font.Size = 11
.Cells(strok+4,stolb+2).Value ="Ëîì À1-1"
.Cells(strok+5,stolb+2).Value ="Ëîì À1-1à"
.Cells(strok+6,stolb+2).Value ="Ëîì À1-2"
.Cells(strok+7,stolb+2).Value ="Ëîì À1-1 ""Å"""
.Cells(strok+8,stolb+2).Value ="Ïîëîñà (ìåäü)"
.Cells(strok+9,stolb+2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
.Cells(strok+10,stolb+2).Value ="Ñëèòîê À1-2 (øëàêîâûå)"
.Cells(strok+11,stolb+2).Value ="Ñëèòîê Ã-2"
.Cells(strok+12,stolb+2).Value ="Ñòðóæêà (ìåäü)"
.Cells(strok+13,stolb+2).Value ="Êàòàíêà áðàê"
.Cells(strok+14,stolb+2).Value ="Ïåðåõîäÿùèé îñòàòîê"
.Cells(strok+15,stolb+2).Borders(9).LineStyle = 1
.Cells(strok+15,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+15,stolb+4).Borders(9).LineStyle = 1
.Cells(strok+15,stolb+2).Borders(9).Weight = 3
.Cells(strok+15,stolb+3).Borders(9).Weight = 3
.Cells(strok+15,stolb+4).Borders(9).Weight = 3
.Cells(strok+16,stolb+2).Value =Chrw (&h2211) & " ="
.Cells(strok+23,stolb+2).Value =Chrw (&h2211) & " ="
.Cells(strok+16,stolb+2).HorizontalAlignment = 4
.Cells(strok+23,stolb+2).HorizontalAlignment = 4
.Cells(strok+16,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+16,stolb+3).Borders(9).Weight = 3
.Cells(strok+23,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+23,stolb+3).Borders(9).Weight = 3
.Cells(strok+24,stolb+2).Borders(9).LineStyle = 1
.Cells(strok+24,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+24,stolb+4).Borders(9).LineStyle = 1
.Cells(strok+24,stolb+2).Borders(9).Weight = 3
.Cells(strok+24,stolb+3).Borders(9).Weight = 3
.Cells(strok+24,stolb+4).Borders(9).Weight = 3
.Cells(strok+18,stolb+2).Value ="Áîðíàÿ êèñëîòà"
.Cells(strok+19,stolb+2).Value ="ÃÌÔ"
.Cells(strok+20,stolb+2).Value ="Ñîäà"
.Cells(strok+21,stolb+2).Value =""
.Cells(strok+22,stolb+2).Value =""
.Cells(strok+27,stolb+2).Value ="Êàòàíêà"
.Cells(strok+28,stolb+2).Value ="Ïîëîñà (ìåäü)"
.Cells(strok+29,stolb+2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
.Cells(strok+30,stolb+2).Value ="Ñòðóæêà (ìåäü)"
.Cells(strok+31,stolb+2).Value ="Êàòàíêà áðàê"
.Cells(strok+32,stolb+2).Value =""
.Cells(strok+33,stolb+2).Value ="Øëàêè (áîðíàÿ êèñëîòà)"
.Cells(strok+34,stolb+2).Value ="Øëàêè (ÃÌÔ)"
.Cells(strok+35,stolb+2).Value ="Øëàêè (ñîäà)"
.Cells(strok+36,stolb+2).Value =""
.Cells(strok+37,stolb+2).Borders(9).LineStyle = 1
.Cells(strok+37,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+37,stolb+4).Borders(9).LineStyle = 1
.Cells(strok+37,stolb+2).Borders(9).Weight = 3
.Cells(strok+37,stolb+3).Borders(9).Weight = 3
.Cells(strok+37,stolb+4).Borders(9).Weight = 3
.Cells(strok+38,stolb+2).Value =Chrw (&h2211) & " ="
.Cells(strok+38,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+38,stolb+2).HorizontalAlignment = 4
.Cells(strok+38,stolb+3).Borders(9).Weight = 3
.Cells(strok+40,stolb+2).Value ="Ïåðåõîäÿùèé îñòàòîê " & Chrw (&h2248)
.Cells(strok+43,stolb+2).Value ="Óãàð"
.Cells(strok+43,stolb+2).HorizontalAlignment = 3
.Cells(strok+45,stolb+2).Value ="Çàìåð ãëóáèíû"
.Cells(strok+46,stolb+2).Value ="Ðàñ÷åòíûé îñòàòîê"
.Cells(strok+47,stolb+2).Value ="Ìàñòåð ñìåíû "
.Cells(strok+51,stolb+2).Font.Italic = False
.Cells(strok+51,stolb+2).Font.Bold = False
.Cells(strok+51,stolb+2).Font.Size = 16
.Cells(strok+51,stolb+2).Value ="Ãë.òåõíîëîã "
.Cells(strok+15,stolb+5).Font.Size = 10
.Cells(strok+17,stolb+5).Font.Size = 10
.Cells(strok+32,stolb+5).Font.Size = 10
.Cells(strok+36,stolb+5).Font.Size = 10
.Cells(strok+15,stolb+5).Value ="çàãðóæåíî ëîìîâ ="
.Cells(strok+17,stolb+5).Value ="çàãðóæåíî ôëþñîâ ="
.Cells(strok+32,stolb+5).Value ="âñåãî îòëèòî ="
.Cells(strok+36,stolb+5).Value ="âñåãî øëàêîâ ="
.Cells(strok+43,stolb+5).Value =" èëè"
''''''''''''''''''''''''''''''''''''''''' .Cells(strok+47,3).Value ="Òðåòüÿêîâ"
.Cells(strok+47,stolb+3).Font.Bold = False
.Cells(strok+47,stolb+3).Font.Size = 16
.Cells(strok+47,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+51,stolb+5).Font.Italic = False
.Cells(strok+51,stolb+5).Font.Size = 16
.Cells(strok+51,stolb+5).Value ="Ìàêàðîâ Â. Þ."
.Cells(strok+23,stolb+7).Font.Underline = True
.Cells(strok+23,stolb+7).Value ="Âñåãî çàãðóæåíî"
.Cells(strok+40,stolb+7).Font.Underline = True
.Cells(strok+40,stolb+7).Value ="Âñåãî ñäàíî"
.Cells(strok+45,stolb+4).Value ="ìì"
.Cells(strok+45,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+15,stolb+7).Value ="êã."
.Cells(strok+15,stolb+6).Borders(9).LineStyle = 1
.Cells(strok+17,stolb+7).Value ="êã."
.Cells(strok+17,stolb+6).Borders(9).LineStyle = 1
.Cells(strok+32,stolb+7).Value ="êã."
.Cells(strok+32,stolb+6).Borders(9).LineStyle = 1
.Cells(strok+36,stolb+7).Value ="êã."
''.Cells(strok+36,stolb+6).Borders(9).LineStyle = 1
.Cells(strok+23,stolb+9).Value ="êã."
.Cells(strok+23,stolb+8).Borders(9).LineStyle = 1
.Cells(strok+40,stolb+9).Value ="êã."
.Cells(strok+40,stolb+8).Borders(9).LineStyle = 1
.Cells(strok+49,stolb+9).Value ="êã, èëè"
.Cells(strok+49,stolb+8).Borders(9).LineStyle = 1
.Cells(strok+49,stolb+10).Borders(9).LineStyle = 1
.Cells(strok+43,stolb+8).Font.Size = 16
.Cells(strok+43,stolb+8).Value ="%"
.Cells(strok+49,stolb+11).Font.Size = 16
.Cells(strok+49,stolb+11).Value ="%"
.Cells(strok+43,stolb+6).Borders(9).LineStyle = 1
.Cells(strok+43,stolb+7).Borders(9).LineStyle = 1
'====================================
.Range("e2:f2:g2").Merge(True)
.Range("f43:g43").Merge(True)
.Range("f45:g45").Merge(True)
.Range("f46:g46").Merge(True)
.Range("f47:g47").Merge(True)
.Range("f49:g49").Merge(True)
.Range("d50:g50").Merge(True)
.Range("d43:e43").Merge(True)
'====================================
.Cells(strok+45,stolb+6).Value ="Âñåãî çàãðóæåíî â ïå÷ü"
.Cells(strok+46,stolb+6).Value ="Îòëèòî"
.Cells(strok+47,stolb+6).Value ="Ðàñ÷åòíûé îñòàòîê"
.Cells(strok+49,stolb+6).Value ="Ðàñ÷åòíûé óãàð"
.Cells(strok+45,stolb+6).HorizontalAlignment = 3
.Cells(strok+46,stolb+6).HorizontalAlignment = 3
.Cells(strok+47,stolb+6).HorizontalAlignment = 3
.Cells(strok+49,stolb+6).HorizontalAlignment = 3
.Cells(strok+45,stolb+8).Borders(9).LineStyle = 1
.Cells(strok+46,stolb+8).Borders(9).LineStyle = 1
.Cells(strok+47,stolb+8).Borders(9).LineStyle = 1
.Cells(strok+49,stolb+8).Borders(9).LineStyle = 1
End With

'====================================KG============================================

For i=4 To 46
If i=15 Or i=17 Or i=24 Or i=25 Or i=26 Or i=32 Or i=36 Or i=37 Or i=39 Or i=41 Or i=42 Or i=44 Or i=45 Then
i=i
Else
With objExcel
.Cells(strok+i,stolb+4).Font.Bold = False
.Cells(strok+i,stolb+4).Font.Italic = True
.Cells(strok+i,stolb+4).Value ="êã."
.Cells(strok+i,stolb+3).Borders(9).LineStyle = 1
.Cells(strok+i,stolb+3).Borders(9).Weight = 2
End With
End If
Next
objExcel.ActiveSheet.Cells(strok+43,stolb+4).Font.Bold = True
objExcel.ActiveSheet.Cells(strok+43,stolb+4).Value ="êã, èëè"

'====================================SUMMA==================================================
With objExcel.ActiveSheet

.Cells(strok+1,stolb+3).Value = "¹ " & NomPlTeg
.Cells(strok+15,stolb+6).Value = SumAllSklad
.Cells(strok+17,stolb+6).Value = SumAllRafinir
.Cells(strok+23,stolb+8).Value = SumAllZagruz
.Cells(strok+45,stolb+3).Value = PodgUroven
.Cells(strok+36,stolb+6).Value = SumAllShlak

End With

'==================SKRYIT PUSTYIE STROKI============================================
Dim Rows
With objExcel.ActiveSheet
.Rows(14).EntireRow.Hidden = True '== ñêðûë íå íóæíûå ñòðîêè
.Rows(21).EntireRow.Hidden = True
.Rows(22).EntireRow.Hidden = True
.Rows(11).EntireRow.Hidden = True
If SumA11 = 0 Then
.Rows(4).EntireRow.Hidden = True
Else
.Cells(strok+4,stolb+3).Value = SumA11
End If
If SumA11a = 0 Then
.Rows(5).EntireRow.Hidden = True
Else
.Cells(strok+5,stolb+3).Value = SumA11a
End If
If SumA12 = 0 Then
.Rows(6).EntireRow.Hidden = True
Else
.Cells(strok+6,stolb+3).Value = SumA12
End If
If SumA12 = 0 Then
.Rows(6).EntireRow.Hidden = True
Else
.Cells(strok+6,stolb+3).Value = SumA12
End If
If SumA11e = 0 Then
.Rows(7).EntireRow.Hidden = True
Else
.Cells(strok+7,stolb+3).Value = SumA11e
End If
If SumPol = 0 Then
.Rows(8).EntireRow.Hidden = True
Else
.Cells(strok+8,stolb+3).Value = SumPol
End If
If SumSlit11 = 0 Then
.Rows(9).EntireRow.Hidden = True
Else
.Cells(strok+9,stolb+3).Value = SumSlit11
End If
If SumSlit12 = 0 Then
.Rows(10).EntireRow.Hidden = True
Else
.Cells(strok+10,stolb+3).Value = SumSlit12
End If
If SumStrug = 0 Then
.Rows(12).EntireRow.Hidden = True
Else
.Cells(strok+12,stolb+3).Value = SumStrug
End If
If SumBrak = 0 Then
.Rows(13).EntireRow.Hidden = True
Else
.Cells(strok+13,stolb+3).Value = SumBrak

End If
If SumBorn = 0 Then
.Rows(18).EntireRow.Hidden = True
Else
.Cells(strok+18,stolb+3).Value = SumBorn

End If
If SumGMF = 0 Then
.Rows(19).EntireRow.Hidden = True
Else
.Cells(strok+19,stolb+3).Value = SumGMF
End If

If SumSoda = 0 Then
.Rows(20).EntireRow.Hidden = True
Else
.Cells(strok+20,stolb+3).Value = SumSoda

End If
If SumBornShlak = 0 Then
.Rows(33).EntireRow.Hidden = True
Else
.Cells(strok+33,stolb+3).Value = SumBornShlak

End If
If SumSodaShlak = 0 Then
.Rows(35).EntireRow.Hidden = True
Else
.Cells(strok+35,stolb+3).Value = SumSodaShlak

End If
If SumGMFShlak = 0 Then
.Rows(34).EntireRow.Hidden = True
Else
.Cells(strok+34,stolb+3).Value = SumGMFShlak

End If

End With

'============================PROVERKA VREMENI=====================================================
If VerifiTimeStart = 0 Or VerifiTimeStart = 1899 Then
objExcel.ActiveSheet.Cells(strok+2,stolb+2).Value ="ÍÅ ÑÓÙÅÑÒÂÓÅÒ"
Else
objExcel.ActiveSheet.Cells(strok+2,stolb+2).Value ="Íà÷àòà: " & SDay & "." & SMonth & "." & SYear & "ã"
objExcel.ActiveSheet.Cells(strok+2,stolb+3).Value = "â " & SHour & ":" & SMinute
If VerifiTimeFin = 0 Or VerifiTimeFin = 1899 Then
objExcel.ActiveSheet.Cells(strok+2,stolb+5).Value ="Òåêóùàÿ."
Else
objExcel.ActiveSheet.Cells(strok+2,stolb+5).Value ="Çàâåðøåíà: " & FDay & "." & FMonth & "." & FYear & "ã "_
& " â " & FHour & ":" & FMinute

End If

End If

'====================================NASTROYIKA STRANICI=====================================

With objExcel.ActiveSheet.PageSetup
.Zoom = False
.CenterVertically = True
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
.RightMargin = 10
.leftMargin = 20
.TopMargin = 15
.HeaderMargin = 10
End With

'========================SAVE FILE============================================================

End If

If Save1 = False Then
objExcel.ActiveSheet.SaveAs PutSaveFile & NameFile
MsgX = MsgBox ("Ôàéë óñïåøíî ñîõðàí¸í.Îòêðûòü ôàéë" & NameFile & " ? " ,4,NameFile)
If MsgX = 6 Then
objExcel.Visible = True
Else
objExcel.Quit
Set objExcel = Nothing
Set fso = Nothing

End If
End If

Set fso = Nothing

'+++++++++++++++++++++++++++++++++++++++++++Ky4a++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++Ky4a++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++Ky4a++++++++++++++++++++++++++++++++++++

''======================== Ñîõðàíåíèå ôàéëà =====================================
''Set fld = ScreenItems("I/O Field3")
''sFileName = fld.OutputValue
'sFileName = "D:\" & Replace(Time, ":", "_", 1,-1)& ".xlsx"'fld.OutputValue
'ExcelSheet.SaveAs sFileName
'ExcelSheet.Application.Quit
'Set ExcelSheet = Nothing
'objExcelApp.Quit
'Set objExcelApp = Nothing
''------------------------
'Ret = MsgBox ("Ôàéë Åêñåëü çàïèñàí íà äèñê. Îòêðûòü ôàéë ?", vbYesNo, "Open file")
'If Ret = vbYes Then
'CreateObject("WScript.Shell").Run sFileName, 1
'End If
''Sub SaveAs()
''
''Dim WorkbookName As String
''
''WorkbookName = Application.GetSaveAsFilename(, , , "Ñîõðàíèòü ôàéë êàê ...")
''
''If Len(WorkbookName) = 0 Or WorkbookName = "False" Then Exit Sub 'ñëó÷àé îòìåíû
'
'ActiveWorkbook.SaveAs WorkbookName
'
'End Sub
'
'Dim objFSO, objRegExp, Path, objFolder, objItem
'Set objFSO = CreateObject("Scripting.FileSystemObject")
'Path = objFSO.GetAbsolutePathName("")
'Set objFolder = objFSO.GetFolder(Path)
'Set objRegExp = CreateObject("VBScript.RegExp")
'objRegExp.Global = True
'objRegExp.Multiline = True
'objRegExp.IgnoreCase = True
'objRegExp.Pattern = NameFile
'For Each objItem In objFolder.Files
' If objRegExp.Test(objItem.Name) = True Then
' WScript.Echo "ôàéë "&objItem.Name&" íàéäåí"
' End If
'Next
' objExcel.ActiveSheet.Range("a19:d19").Select
'Selection.EntireRow.Hidden = True
'strok = strok-1
'Selection.EntireRow.Hidden = True
'objExcel.ActiveSheet.Rows(19).EntireColumn.Hidden = True 'Ñêðûòü ñòðîêó

' objExcel.ActiveSheet.Range("a19:d19").Select
'Selection.EntireRow.Hidden = True
'strok = strok-1
'Selection.EntireRow.Hidden = True
'objExcel.ActiveSheet.Rows(19).EntireColumn.Hidden = True 'Ñêðûòü ñòðîêó

End Sub

Поделиться15Четверг, 27 декабря, 2012г. 15:05:36

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

'Dim OpenDialog ,Filename
'
'Set OpenDialog = CreateObject("MSComDlg.CommonDialog") 'Microsoft Common Dialog Control
'With OpenDialog
' .DialogTitle = "Îòêðîéòå íóæíûé Âàì ôàéë!"
' .InitDir = "C:\WINDOWS\"
' .Filter = "Âñå ôàéëû (*.*)|*.*|Ïðîãðàììû (*.com,*.exe)|*.com;*.exe|Òåêñò (*.txt,*.log)|*.txt;*.log"
' .FilterIndex = 2
' .Flags = 2621952
' .MaxFileSize =32000
' .ShowOpen
' Filename = .Filename
'End With
'
'If (Len(OpenDialog.FileName)= 0) Then
' WScript.Echo "Ôàéëû íå âûáðàíû!"
' WScript.Quit 1
'End If

'
'
''===================OTKP FILE===================================
'Dim intResult,objDialog
'
'Set objDialog = CreateObject("SAFRCFileDlg.FileOpen")
'intResult = objDialog.OpenFileOpenDlg
'WScript.Echo "Ðåçóëüòàò îïåðàöèè: " & CStr(intResult)
'WScript.Echo "Âûáðàí ôàéë: " & objDialog.FileName
''=================================================================

'Dim ob,s, Sys,r
'
'
'Set Sys = CreateObject("JSSys3.Ops")
'r = Sys.OpenDlg("Îòêðûòü ôàéë", "bmp", "C:\")
'WScript.Echo r
'r = Sys.OpenMultiDlg("Îòêðûòü íåñêîëüêî ôàéëîâ", "", "")
'WScript.Echo r
'r = Sys.SaveDlg("Ñîõðàíèòü ôàéë", "txt")
'WScript.Echo r
'r = Sys.ColorDlg
'WScript.Echo r ' âîçâðàùàåò øåñòèñèìâîëüíûé êîä (ñòðîêà)
'r = Sys.BrowseForFolder("Âûáîð ïàïêè")
'WScript.Echo r

'Set ob = createobject("Jsdlgbox.browser")
's = ob.openbox
'WScript.Echo s
's = ob.savebox
'WScript.Echo s
's = ob.colorboxrgb
'WScript.Echo s ' âîçâðàùàåò Ñèíèé*65536 + Çåëåíûé*256 + Êðàñíûé
's = ob.colorboxhex
'WScript.Echo s ' âîçâðàùàåò 6-ñèìâîëüíûé êîä (ñòðîêó)
'

''====================OTKRYIT FILE=======================================
' Dim objDialog,myDir,myFilter,GetFileName
'
' ' Create a dialog object
' Set objDialog = CreateObject ( "UserAccounts.CommonDialog" )
' 'HMIRuntime.Tags ("@UA_Plavka_Otchyet_Put").Write a.FileName
'
' ' Check arguments and use defaults when necessary
' If myDir = "" Then
' ' Default initial folder is "My Documents"
' objDialog.InitialDir = CreateObject( "WScript.Shell" ).SpecialFolders( "MyDocuments" )
' Else
' ' Use the specified initial folder
' objDialog.InitialDir = HMIRuntime.Tags ("@UA_Plavka_Otchyet_Put").Write'myDir
' End If
' If myFilter = "" Then
' ' Default file filter is "All files"
' objDialog.Filter = "Xls files (*.xls) | *.xls"
' Else
' ' Use the specified file filter
' objDialog.Filter = myFilter
' End If
'
' ' Open the dialog and return the selected file name
' If objDialog.ShowOpen Then
' GetFileName = objDialog.FileName
' Else
' GetFileName = ""
' End If
''===============================================================================
'
'

''Type OPENFILENAME
'' StructSize As Long
'' Owner As Long
'' Instance As Long
'' Filter As String
'' CustomFilter As Long
'' MaxCustrFilter As Long
'' FilterIndex As Long
'' File As String
'' MaxFile As Long
'' FileTitle As String
'' MaxFileTitle As Long
'' InitialDir As String
'' Title As String
'' Flags As Long
'' FileOffset As Integer
'' FileExtension As Integer
'' DefExt As String
'' CustrData As Long
'' Hook As Long
'' TemplateName As Long
''End Type
'
''Ïåðåìåííàÿ ñ ïîëó÷åííûì ïóò¸ì äî ôàéëà
'Dim File As String
''Ôèëüòð ôàéëîâ
'Dim CommDlgF As String * 512
''Ïåðåìåííàÿ äëÿ ïåðåäà÷è API ôóíêöèè
'Dim OpenFileName As OPENFILENAME
''Áóôåð äëÿ îáðàáîòêè ñòðîêè
'Dim Buf As Variant
'
'CommDlgF = "Òåêñòîâûå ôàéëû|*.txt"
'
''Íîìåð ôîðìû
'OpenFileName.Owner = Me.hWnd
'OpenFileName.Instance = 0
'OpenFileName.CustomFilter = 0
'OpenFileName.MaxCustrFilter = 0
'OpenFileName.Hook = 0
'OpenFileName.TemplateName = 0
'OpenFileName.CustrData = 0
''Äëèíà ôàéëà
'OpenFileName.File = String$(512, 0)
'OpenFileName.MaxFile = 511
'
'
'If Len(CommDlgF) > 0 Then
' For I = 1 To Len(CommDlgF)
' If Mid(CommDlgF, I, 1) = "|" Then
' Buf = Buf + vbNullChar
' Else
' Buf = Buf + Mid(CommDlgF, I, 1)
' End If
' Next I
' CommDlgF = Buf
'End If
'
''Ïðèñâàèâàåì ôèëüòð
'OPENFILENAME.Filter = CommDlgF
''Ïðèñâàèâàåì çàãîëîâîê îêíà
'OPENFILENAME.Title = "Îòêðûòèå ôàéëà"
''Êàòàëîã ïî óìîë÷àíèþ
'OPENFILENAME.InitialDir = "c:\"
''Äðóãèå ñâîéñòâà äèàëîãà
'OPENFILENAME.Flags = &H0
''Äëèíà âñåé ïåðåìåííîé
'OPENFILENAME.StructSize = Len(OPENFILENAME)
'
'If GetOpenFileName(OpenFileName) = True Then
' Buf = InStr(1, OPENFILENAME.File, Chr(0))
' MsgBox "Âû âûáðàëè " & Left(OpenFileName.File, Buf - 1)
'Else
' MsgBox "Îøèáêà"
'End If
'
'
'

Поделиться16Четверг, 27 декабря, 2012г. 21:26:00

Автор: 6akJIAH
Администратор
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 12
Провел на форуме:
1 час 12 минут
Последний визит:
Понедельник, 11 февраля, 2013г. 00:57:09

VisualBasic_Function.zip

http://narod.ru/disk/64891809001.c3a072 … n.zip.html

Поделиться17Четверг, 27 декабря, 2012г. 21:27:03

Автор: 6akJIAH
Администратор
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 12
Провел на форуме:
1 час 12 минут
Последний визит:
Понедельник, 11 февраля, 2013г. 00:57:09

Total Commander.zip

http://narod.ru/disk/64891875001.2fb3301506b2f66397f73ff70214158b/Total Commander.zip.html

Поделиться18Пятница, 28 декабря, 2012г. 08:26:26

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Dim objShellApp,objFolder

On Error Resume Next

Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.BrowseForFolder(0, "Âûáîð ïàïêè", 0, "D:\")

objFolder.Visible = True
HMIRuntime.Tags ("@UA_Plavka_Otchyet_Put").Write objFolder.Self.Path

If Err.Number <> 0 Then
Set objShellApp = Nothing
Set objFolder = Nothing
End If

Отредактировано X1 (Пятница, 28 декабря, 2012г. 08:26:43)

Поделиться19Пятница, 28 декабря, 2012г. 09:02:10

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

http://www.4its.ru/html/windows-script-host.html

Поделиться20Пятница, 28 декабря, 2012г. 14:59:59

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Sub OnClick(Byval Item)
'HMIRuntime.Trace Now & vbCrLf

Dim objExcel ,i, m ,m2,m3,m4,Marka_shihti,k , arrPodg , arrSklad
Dim Kol_Shihta, Nom_plav_zagr, NomPlTeg, MarkSTeg,KolA11,SumA11
Dim KolA11a,SumA11a,SumA12,KolA12,SumA11e,KolA11e,SumPol,KolPol
Dim SumSlit11,KolSlit11,SumSlit12,KolSlit12 ,SumStrug ,KolStrug
Dim SumBrak ,KolBrak,SumAllSklad,SDay,SMonth ,SYear,SHour,SMinute
Dim TimeStPod,TimeFinPod, TimePrihod, TimeRashod, PodgUroven
Dim FDay,FMonth ,FYear,FHour,FMinute,VerifiTimeFin,VerifiTimeStart
Dim arrRafinir,BornAcid,SumBorn,GMF1,GMF2,SumGMF,Soda1,Soda2,SumSoda
Dim SumAllRafinir,SumAllZagruz,a,a1,SaveFolder
Dim arrVosst,BornAcidShlak,SumBornShlak,GMF1Shlak,GMF2Shlak,SumGMFShlak
Dim Soda1Shlak,Soda2Shlak,SumSodaShlak,SumAllShlak
Dim PutSaveFile, NameFile, DataPlavk ,MsgX,MsgX2,fso,Save1
Dim strok,stolb,PutSaveFile1,RealPlavka

'Set rst = CreateObject("ADODB.Recordset")
'con = "Provider = SQLOLEDB;Initial Catalog = " & "S01_@DatasourceNameRT" & ";Data Source = S01\WinCC;Integrated Security = SSPI"
'

NomPlTeg = HMIRuntime.Tags("NomPLAV").Read
MarkSTeg = HMIRuntime.Tags("MarkSTeg").Read

arrSklad = UARead ("Sklad")
arrPodg = UARead ("Podgotovka")
arrRafinir = UARead ("Rafinirovanie")
arrVosst = UARead ("Vosstanovlenie")

'===============PROVERKA NALICHIYA PUTI=======================================
PutSaveFile = HMIRuntime.Tags("@UA_Plavka_Otchyet_Put").Read
a=Right(PutSaveFile,1)
If a = "\" Then
a1 = Len(PutSaveFile) '=====îòñå÷åíèå \ â êîíöå
a1 =a1 - 1
PutSaveFile = Left(PutSaveFile,a1)
End If
If PutSaveFile = "" Then
MsgBox (" Óêàæèòå ïóòü ñîõðàíåíèÿ ôàéëà! ")
PutSaveFile1 = False
Else
PutSaveFile1 = True
End If

'================================================SKLAD=========================================
For m = 0 To (UBound(arrSklad)-1)
If arrSklad(m,5) = NomPlTeg Or NomPlTeg = "0" Then

'=============================A1-1==================================
If arrSklad(m,1)="A1-1" Then

KolA11 = Int (arrSklad(m,2))
SumA11 = SumA11 + KolA11
'HMIRuntime.Trace " KolS " & KolA11 & " SumKS " & SumA11

End If
'=============================A1-1a==================================
If arrSklad(m,1)="A1-1a" Then

KolA11a = Int (arrSklad(m,2))
SumA11a = SumA11a + KolA11a
'HMIRuntime.Trace " KolS " & KolA11a & " SumKS " & SumA11a

End If
'=============================A1-2==================================
If arrSklad(m,1)="A1-2" Then

KolA12 = Int (arrSklad(m,2))
SumA12 = SumA12 + KolA12
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================A1-1e==================================
If arrSklad(m,1)="À1-1Å" Then

KolA11e = Int (arrSklad(m,2))
SumA11e = SumA11e + KolA11e
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÏÎËÎÑÀ==================================
If arrSklad(m,1)="Ïîëîñà" Then

KolPol = Int (arrSklad(m,2))
SumPol = SumPol + KolPol
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÑëèòîêÀ1-1==================================
If arrSklad(m,1)="Ñëèòêè 1-1" Then

KolSlit11 = Int (arrSklad(m,2))
SumSlit11 = SumSlit11 + KolSlit11
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÑëèòîêÀ1-2==================================
If arrSklad(m,1)="Ñëèòêè 1-2" Then

KolSlit12 = Int (arrSklad(m,2))
SumSlit12 = SumSlit12 + KolSlit12
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================Ñòðóæêà==================================
If arrSklad(m,1)="Ñòðóæêà" Then

KolStrug = Int (arrSklad(m,2))
SumStrug = SumStrug + KolStrug
'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If
'=============================ÊàòàíêàÁðàê==================================
If arrSklad(m,1)="Áðàê" Then
SumBrak = Int (SumBrak)
KolBrak = Int (arrSklad(m,2))
SumBrak = SumBrak + KolBrak

'HMIRuntime.Trace " KolS " & KolA12 & " SumKS " & SumA12

End If

End If
Marka_shihti = arrSklad(m,1)
Kol_Shihta = arrSklad(m,2)
Nom_plav_zagr = arrSklad(m,5)
TimePrihod = arrSklad(m,3)
TimeRashod = arrSklad(m,4)
' Nom_Porcii_Zagr = arr(m,7)
' Zadanie_plavka= arr(m,6)
' Zadanie_plavka=Left(Zadanie_plavka,12)
' Nom_plav_Plan = arr(m,8)

'=========================================RAFINIROVANIE=======================================

For m4 = 0 To (UBound(arrRafinir)-1)
'HMIRuntime.Trace arrRafinir(m4,1)& vbCrLf
If arrRafinir(m4,1) = NomPlTeg Then

'===========BORN====================
BornAcid = Int(arrRafinir(m4,79))
SumBorn = SumBorn + BornAcid
'============GMF====================
GMF1 = Int(arrRafinir(m4,80))
GMF2 = Int(arrRafinir(m4,81))
SumGMF = SumGMF + (GMF1 + GMF2)
'=============SODA===================
Soda1 = Int(arrRafinir(m4,82))
Soda2 = Int(arrRafinir(m4,83))
SumSoda = SumSoda + (Soda1 + Soda2)
'====================================
'HMIRuntime.Trace vbCrLf & m4 & vbCrLf & m3 & vbCrLf & BornAcid& vbCrLf & SumBorn& vbCrLf & GMF1& vbCrLf & GMF2 & vbCrLf & Soda1 & vbCrLf
Exit For
End If
Next
SumAllRafinir = SumBorn + SumGMF + SumSoda
SumAllZagruz = SumAllRafinir + SumAllSklad

'=======================SHLAK===Vosstanovlenie==============================================================

For m3 = 0 To (UBound(arrVosst)-1)
'HMIRuntime.Trace arrVosst(m3,1)& vbCrLf
If arrVosst(m3,1) = NomPlTeg Then

'===========BORN==Shlak==================
BornAcidShlak = Int(arrVosst(m3,76))
SumBornShlak = SumBornShlak + BornAcidShlak
'============GMF==Shlak==================
GMF1Shlak = Int(arrVosst(m3,77))
GMF2Shlak = Int(arrVosst(m3,78))
SumGMFShlak = SumGMFShlak + (GMF1Shlak + GMF2Shlak)
'=============SODA==Shlak=================
Soda1Shlak = Int(arrVosst(m3,79))
Soda2Shlak = Int(arrVosst(m3,80))
SumSodaShlak = SumSodaShlak + (Soda1Shlak + Soda2Shlak)
'====================================
'HMIRuntime.Trace vbCrLf & m4 & vbCrLf & m3 & vbCrLf & BornAcid& vbCrLf & SumBorn& vbCrLf & GMF1& vbCrLf & GMF2 & vbCrLf & Soda1 & vbCrLf
Exit For
End If
Next

SumAllShlak = SumBornShlak + SumGMFShlak + SumSodaShlak

'====================================Vremya plavki===================================

For m2 = 0 To (UBound(arrPodg)-1)

If arrPodg(m2,45)= NomPlTeg Then

TimeStPod = arrPodg(m2,49)
TimeFinPod = arrPodg(m2+1,49)
PodgUroven = arrPodg(m2+1,47)
TimeStPod = CDate(TimeStPod)
SDay = Day(TimeStPod)
SMonth = Month(TimeStPod)
SYear = Year(TimeStPod)
SHour = Hour(TimeStPod)
SMinute = Minute(TimeStPod)

TimeFinPod = CDate(TimeFinPod)
FDay = Day(TimeFinPod)
FMonth = Month(TimeFinPod)
FYear = Year(TimeFinPod)
FHour = Hour(TimeFinPod)
FMinute = Minute(TimeFinPod)

VerifiTimeStart = Int(SYear)
VerifiTimeFin = Int(FYear)

Exit For

End If
Next

'===========================PROVERKA NA NALICHIE FILE.xls=============================================================

Save1 = False

DataPlavk = SDay & "." & SMonth & "." & SYear & "ã"
NameFile = "Ïëàâêà ¹ " & NomPlTeg & "_" & DataPlavk
HMIRuntime.Tags("@UA_FileName_Plavka").Write NameFile

'HMIRuntime.Trace "__________" & PutSaveFile & NameFile & vbCrLf

Set fso= CreateObject("Scripting.FileSystemObject")

With fso
If .FileExists(PutSaveFile & "\" & NameFile & ".xls" ) Then
Save1 = True
MsgX2 = MsgBox ( NameFile &" Òàêîé ôàéë óæå ñóùåñòâóåò. Çàìåíèòü? " ,4,NameFile)

If MsgX2 = 6 Then
.DeleteFile PutSaveFile & "\" & NameFile & ".xls", True
' HMIRuntime.Trace " ÔÀÉË ÓÄÀË¨Í "
Save1 = False
   Else
   Save1 = True
End If

End If

End With

'============================ PROVERKA VREMENI START =====================================================
If VerifiTimeStart = 0 Or VerifiTimeStart = 1899 Then
RealPlavka = False
MsgBox (" ÏËÀÂÊÀ Ñ ÒÀÊÈÌ ÍÎÌÅÐÎÌ ÍÅ ÑÓÙÅÑÒÂÓÅÒ! ")
PutSaveFile1 = False
Else
RealPlavka = True

End If

'====================PROVERKA NA NALICHIE PAPKI============================================

SaveFolder = fso.FolderExists (PutSaveFile)
If SaveFolder = False Then
PutSaveFile1 = False
MsgBox (" Ïàïêà ñ òàêèì èìåíåì íå ñóùåñòâóåò! ")
End If

'=========================CREATE EXCEL=======================================================
If PutSaveFile1 = True Then '& RealPlavka = True

If save1 = False Then

Set objExcel = CreateObject("Excel.application")
objExcel.Visible = False
objExcel.Workbooks.add
strok = 0
stolb = 0

With objExcel.ActiveSheet
   .Cells.Font.Italic = True
   .Cells.Font.Bold = True
   .Cells.Font.Size = 12
   .Cells.Font.Name = "Arial" '"Times New Roman"
   .Columns(stolb+1).ColumnWidth = 12
   .Columns(stolb+2).ColumnWidth = 30
   .Columns(stolb+3).ColumnWidth = 10
   .Columns(stolb+4).ColumnWidth = 4
   .Columns(stolb+5).ColumnWidth = 18
   .Columns(stolb+7).ColumnWidth = 22
   .Columns(stolb+9).ColumnWidth = 7
   .Columns(stolb+11).ColumnWidth = 4
   .Cells(strok+3,stolb+1).Font.Size = 16
   .Cells(strok+3,stolb+1).Font.Italic = False
   .Cells(strok+3,stolb+1).Value ="Çàãðóæåíî:"
   .Cells(strok+26,stolb+1).Font.Size = 16
   .Cells(strok+26,stolb+1).Font.Italic = False
   .Cells(strok+26,stolb+1).Font.Underline = True
   .Cells(strok+26,stolb+1).Value ="Îòëèòî:"
   .Cells(strok+1,stolb+2).Font.Size = 20
   .Cells(strok+1,stolb+2).Font.Italic = False
   .Cells(strok+1,stolb+2).Value = "ÏËÀÂÊÀ"
   .Cells(strok+1,stolb+2).HorizontalAlignment = 4
   .Cells(strok+1,stolb+3).Font.Size = 16
   .Cells(strok+1,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+1,stolb+3).Borders(9).Weight = 4
   .Cells(strok+2,stolb+2).Font.Bold = False
   .Cells(strok+2,stolb+3).Font.Bold = False
   .Cells(strok+2,stolb+5).Font.Bold = False
   .Cells(strok+2,stolb+2).Font.Size = 11
   .Cells(strok+2,stolb+3).Font.Size = 11
   .Cells(strok+2,stolb+5).Font.Size = 11
   .Cells(strok+4,stolb+2).Value ="Ëîì À1-1"
   .Cells(strok+5,stolb+2).Value ="Ëîì À1-1à"
   .Cells(strok+6,stolb+2).Value ="Ëîì À1-2"
   .Cells(strok+7,stolb+2).Value ="Ëîì À1-1 ""Å"""
   .Cells(strok+8,stolb+2).Value ="Ïîëîñà (ìåäü)"
   .Cells(strok+9,stolb+2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
   .Cells(strok+10,stolb+2).Value ="Ñëèòîê À1-2 (øëàêîâûå)"
   .Cells(strok+11,stolb+2).Value ="Ñëèòîê Ã-2"
   .Cells(strok+12,stolb+2).Value ="Ñòðóæêà (ìåäü)"
   .Cells(strok+13,stolb+2).Value ="Êàòàíêà áðàê"
   .Cells(strok+14,stolb+2).Value ="Ïåðåõîäÿùèé îñòàòîê"
   .Cells(strok+15,stolb+2).Borders(9).LineStyle = 1
   .Cells(strok+15,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+15,stolb+4).Borders(9).LineStyle = 1
   .Cells(strok+15,stolb+2).Borders(9).Weight = 3
   .Cells(strok+15,stolb+3).Borders(9).Weight = 3
   .Cells(strok+15,stolb+4).Borders(9).Weight = 3
   .Cells(strok+16,stolb+2).Value =Chrw (&h2211) & " ="
   .Cells(strok+23,stolb+2).Value =Chrw (&h2211) & " ="
   .Cells(strok+16,stolb+2).HorizontalAlignment = 4
   .Cells(strok+23,stolb+2).HorizontalAlignment = 4
   .Cells(strok+16,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+16,stolb+3).Borders(9).Weight = 3
   .Cells(strok+23,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+23,stolb+3).Borders(9).Weight = 3
   .Cells(strok+24,stolb+2).Borders(9).LineStyle = 1
   .Cells(strok+24,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+24,stolb+4).Borders(9).LineStyle = 1
   .Cells(strok+24,stolb+2).Borders(9).Weight = 3
   .Cells(strok+24,stolb+3).Borders(9).Weight = 3
   .Cells(strok+24,stolb+4).Borders(9).Weight = 3
   .Cells(strok+18,stolb+2).Value ="Áîðíàÿ êèñëîòà"
   .Cells(strok+19,stolb+2).Value ="ÃÌÔ"
   .Cells(strok+20,stolb+2).Value ="Ñîäà"
   .Cells(strok+21,stolb+2).Value =""
   .Cells(strok+22,stolb+2).Value =""
   .Cells(strok+27,stolb+2).Value ="Êàòàíêà"
   .Cells(strok+28,stolb+2).Value ="Ïîëîñà (ìåäü)"
   .Cells(strok+29,stolb+2).Value ="Ñëèòîê À1-1 (÷èñòûå)"
   .Cells(strok+30,stolb+2).Value ="Ñòðóæêà (ìåäü)"
   .Cells(strok+31,stolb+2).Value ="Êàòàíêà áðàê"
   .Cells(strok+32,stolb+2).Value =""
   .Cells(strok+33,stolb+2).Value ="Øëàêè (áîðíàÿ êèñëîòà)"
   .Cells(strok+34,stolb+2).Value ="Øëàêè (ÃÌÔ)"
   .Cells(strok+35,stolb+2).Value ="Øëàêè (ñîäà)"
   .Cells(strok+36,stolb+2).Value =""
   .Cells(strok+37,stolb+2).Borders(9).LineStyle = 1
   .Cells(strok+37,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+37,stolb+4).Borders(9).LineStyle = 1
   .Cells(strok+37,stolb+2).Borders(9).Weight = 3
   .Cells(strok+37,stolb+3).Borders(9).Weight = 3
   .Cells(strok+37,stolb+4).Borders(9).Weight = 3
   .Cells(strok+38,stolb+2).Value =Chrw (&h2211) & " ="
   .Cells(strok+38,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+38,stolb+2).HorizontalAlignment = 4
   .Cells(strok+38,stolb+3).Borders(9).Weight = 3
   .Cells(strok+40,stolb+2).Value ="Ïåðåõîäÿùèé îñòàòîê " & Chrw (&h2248)
   .Cells(strok+43,stolb+2).Value ="Óãàð"
   .Cells(strok+43,stolb+2).HorizontalAlignment = 3
   .Cells(strok+45,stolb+2).Value ="Çàìåð ãëóáèíû"
   .Cells(strok+46,stolb+2).Value ="Ðàñ÷åòíûé îñòàòîê"
   .Cells(strok+47,stolb+2).Value ="Ìàñòåð ñìåíû "
   .Cells(strok+51,stolb+2).Font.Italic = False
   .Cells(strok+51,stolb+2).Font.Bold = False
   .Cells(strok+51,stolb+2).Font.Size = 16
   .Cells(strok+51,stolb+2).Value ="Ãë.òåõíîëîã "
   .Cells(strok+15,stolb+5).Font.Size = 10
   .Cells(strok+17,stolb+5).Font.Size = 10
   .Cells(strok+32,stolb+5).Font.Size = 10
   .Cells(strok+36,stolb+5).Font.Size = 10
   .Cells(strok+15,stolb+5).Value ="çàãðóæåíî ëîìîâ ="
   .Cells(strok+17,stolb+5).Value ="çàãðóæåíî ôëþñîâ ="
   .Cells(strok+32,stolb+5).Value ="âñåãî îòëèòî ="
   .Cells(strok+36,stolb+5).Value ="âñåãî øëàêîâ ="
   .Cells(strok+43,stolb+5).Value =" èëè"
''''''''''''''''''''''''''''''''''''''''' .Cells(strok+47,3).Value ="Òðåòüÿêîâ"
   .Cells(strok+47,stolb+3).Font.Bold = False
   .Cells(strok+47,stolb+3).Font.Size = 16
   .Cells(strok+47,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+51,stolb+5).Font.Italic = False
   .Cells(strok+51,stolb+5).Font.Size = 16
   .Cells(strok+51,stolb+5).Value ="Ìàêàðîâ Â. Þ."
   .Cells(strok+23,stolb+7).Font.Underline = True
   .Cells(strok+23,stolb+7).Value ="Âñåãî çàãðóæåíî"
   .Cells(strok+40,stolb+7).Font.Underline = True
   .Cells(strok+40,stolb+7).Value ="Âñåãî ñäàíî"
   .Cells(strok+45,stolb+4).Value ="ìì"
   .Cells(strok+45,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+15,stolb+7).Value ="êã."
   .Cells(strok+15,stolb+6).Borders(9).LineStyle = 1
   .Cells(strok+17,stolb+7).Value ="êã."
   .Cells(strok+17,stolb+6).Borders(9).LineStyle = 1
   .Cells(strok+32,stolb+7).Value ="êã."
   .Cells(strok+32,stolb+6).Borders(9).LineStyle = 1
   .Cells(strok+36,stolb+7).Value ="êã."
   ''.Cells(strok+36,stolb+6).Borders(9).LineStyle = 1
   .Cells(strok+23,stolb+9).Value ="êã."
   .Cells(strok+23,stolb+8).Borders(9).LineStyle = 1
   .Cells(strok+40,stolb+9).Value ="êã."
   .Cells(strok+40,stolb+8).Borders(9).LineStyle = 1
   .Cells(strok+49,stolb+9).Value ="êã, èëè"
   .Cells(strok+49,stolb+8).Borders(9).LineStyle = 1
   .Cells(strok+49,stolb+10).Borders(9).LineStyle = 1
   .Cells(strok+43,stolb+8).Font.Size = 16
   .Cells(strok+43,stolb+8).Value ="%"
   .Cells(strok+49,stolb+11).Font.Size = 16
   .Cells(strok+49,stolb+11).Value ="%"
   .Cells(strok+43,stolb+6).Borders(9).LineStyle = 1
   .Cells(strok+43,stolb+7).Borders(9).LineStyle = 1
'====================================
   .Range("e2:f2:g2").Merge(True)
   .Range("f43:g43").Merge(True)
   .Range("f45:g45").Merge(True)
   .Range("f46:g46").Merge(True)
   .Range("f47:g47").Merge(True)
   .Range("f49:g49").Merge(True)
   .Range("d50:g50").Merge(True)
   .Range("d43:e43").Merge(True)
'====================================
   .Cells(strok+45,stolb+6).Value ="Âñåãî çàãðóæåíî â ïå÷ü"
   .Cells(strok+46,stolb+6).Value ="Îòëèòî"
   .Cells(strok+47,stolb+6).Value ="Ðàñ÷åòíûé îñòàòîê"
   .Cells(strok+49,stolb+6).Value ="Ðàñ÷åòíûé óãàð"
   .Cells(strok+45,stolb+6).HorizontalAlignment = 3
   .Cells(strok+46,stolb+6).HorizontalAlignment = 3
   .Cells(strok+47,stolb+6).HorizontalAlignment = 3
   .Cells(strok+49,stolb+6).HorizontalAlignment = 3
   .Cells(strok+45,stolb+8).Borders(9).LineStyle = 1
   .Cells(strok+46,stolb+8).Borders(9).LineStyle = 1
   .Cells(strok+47,stolb+8).Borders(9).LineStyle = 1
   .Cells(strok+49,stolb+8).Borders(9).LineStyle = 1
End With

'====================================KG============================================

For i=4 To 46
If i=15 Or i=17 Or i=24 Or i=25 Or i=26 Or i=32 Or i=36 Or i=37 Or i=39 Or i=41 Or i=42 Or i=44 Or i=45 Then
i=i
Else
   With objExcel
   .Cells(strok+i,stolb+4).Font.Bold = False
   .Cells(strok+i,stolb+4).Font.Italic = True
   .Cells(strok+i,stolb+4).Value ="êã."
   .Cells(strok+i,stolb+3).Borders(9).LineStyle = 1
   .Cells(strok+i,stolb+3).Borders(9).Weight = 2
   End With
End If
Next
objExcel.ActiveSheet.Cells(strok+43,stolb+4).Font.Bold = True
objExcel.ActiveSheet.Cells(strok+43,stolb+4).Value ="êã, èëè"

'====================================SUMMA==================================================
With objExcel.ActiveSheet


   .Cells(strok+1,stolb+3).Value = "¹ " & NomPlTeg
.Cells(strok+15,stolb+6).Value = SumAllSklad
.Cells(strok+17,stolb+6).Value = SumAllRafinir
.Cells(strok+23,stolb+8).Value = SumAllZagruz
.Cells(strok+45,stolb+3).Value = PodgUroven
.Cells(strok+36,stolb+6).Value = SumAllShlak



End With

'==================SKRYIT PUSTYIE STROKI============================================
Dim Rows
With objExcel.ActiveSheet
.Rows(14).EntireRow.Hidden = True '== ñêðûë íå íóæíûå ñòðîêè
.Rows(21).EntireRow.Hidden = True
.Rows(22).EntireRow.Hidden = True
.Rows(11).EntireRow.Hidden = True
If SumA11 = 0 Then
.Rows(4).EntireRow.Hidden = True
   Else
      .Cells(strok+4,stolb+3).Value = SumA11
End If
If SumA11a = 0 Then
.Rows(5).EntireRow.Hidden = True
   Else
         .Cells(strok+5,stolb+3).Value = SumA11a
End If
If SumA12 = 0 Then
.Rows(6).EntireRow.Hidden = True
   Else
      .Cells(strok+6,stolb+3).Value = SumA12
End If
If SumA12 = 0 Then
.Rows(6).EntireRow.Hidden = True
   Else
         .Cells(strok+6,stolb+3).Value = SumA12
End If
If SumA11e = 0 Then
.Rows(7).EntireRow.Hidden = True
   Else
   .Cells(strok+7,stolb+3).Value = SumA11e
End If
If SumPol = 0 Then
.Rows(8).EntireRow.Hidden = True
   Else
   .Cells(strok+8,stolb+3).Value = SumPol
End If
If SumSlit11 = 0 Then
.Rows(9).EntireRow.Hidden = True
   Else
   .Cells(strok+9,stolb+3).Value = SumSlit11
End If
If SumSlit12 = 0 Then
.Rows(10).EntireRow.Hidden = True
   Else
   .Cells(strok+10,stolb+3).Value = SumSlit12
End If
If SumStrug = 0 Then
.Rows(12).EntireRow.Hidden = True
   Else
   .Cells(strok+12,stolb+3).Value = SumStrug
End If
If SumBrak = 0 Then
.Rows(13).EntireRow.Hidden = True
   Else
   .Cells(strok+13,stolb+3).Value = SumBrak

End If
If SumBorn = 0 Then
.Rows(18).EntireRow.Hidden = True
   Else
   .Cells(strok+18,stolb+3).Value = SumBorn

End If
If SumGMF = 0 Then
.Rows(19).EntireRow.Hidden = True
   Else
   .Cells(strok+19,stolb+3).Value = SumGMF
End If

If SumSoda = 0 Then
.Rows(20).EntireRow.Hidden = True
   Else
   .Cells(strok+20,stolb+3).Value = SumSoda

End If
If SumBornShlak = 0 Then
.Rows(33).EntireRow.Hidden = True
   Else
   .Cells(strok+33,stolb+3).Value = SumBornShlak

End If
If SumSodaShlak = 0 Then
.Rows(35).EntireRow.Hidden = True
   Else
   .Cells(strok+35,stolb+3).Value = SumSodaShlak

End If
If SumGMFShlak = 0 Then
.Rows(34).EntireRow.Hidden = True
   Else
   .Cells(strok+34,stolb+3).Value = SumGMFShlak

End If

End With

'============================PROVERKA VREMENI=====================================================
   If VerifiTimeStart = 0 Or VerifiTimeStart = 1899 Then
objExcel.ActiveSheet.Cells(strok+2,stolb+2).Value ="ÍÅ ÑÓÙÅÑÒÂÓÅÒ"
Else
RealPlavka = True
   objExcel.ActiveSheet.Cells(strok+2,stolb+2).Value ="Íà÷àòà: " & SDay & "." & SMonth & "." & SYear & "ã"
objExcel.ActiveSheet.Cells(strok+2,stolb+3).Value = "â " & SHour & ":" & SMinute
If VerifiTimeFin = 0 Or VerifiTimeFin = 1899 Then
objExcel.ActiveSheet.Cells(strok+2,stolb+5).Value ="Òåêóùàÿ."
Else

objExcel.ActiveSheet.Cells(strok+2,stolb+5).Value ="Çàâåðøåíà: " & FDay & "." & FMonth & "." & FYear & "ã "_
      & " â " & FHour & ":" & FMinute

End If

   End If

'====================================NASTROYIKA STRANICI=====================================

With objExcel.ActiveSheet.PageSetup
   .Zoom = False
   .CenterVertically = True
   .FitToPagesWide = 1
   .FitToPagesTall = 1
   .CenterHorizontally = True
   .CenterVertically = True
   .RightMargin = 10
   .leftMargin = 20
   .TopMargin = 15
   .HeaderMargin = 10
End With

'========================SAVE FILE============================================================

End If

If Save1 = False Then ' & RealPlavka = True
objExcel.ActiveSheet.SaveAs PutSaveFile & "\" & NameFile
MsgX = MsgBox ("Ôàéë óñïåøíî ñîõðàí¸í.Îòêðûòü ôàéë" & NameFile & " ? " ,4,NameFile)
If MsgX = 6 Then
objExcel.Visible = True
Else
objExcel.Quit
Set objExcel = Nothing
   Set fso = Nothing

End If
End If
End If

Set fso = Nothing

'+++++++++++++++++++++++++++++++++++++++++++Ky4a++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++Ky4a++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++Ky4a++++++++++++++++++++++++++++++++++++

''======================== Ñîõðàíåíèå ôàéëà =====================================
''Set fld = ScreenItems("I/O Field3")
''sFileName = fld.OutputValue
'sFileName = "D:\" & Replace(Time, ":", "_", 1,-1)& ".xlsx"'fld.OutputValue
'ExcelSheet.SaveAs sFileName
'ExcelSheet.Application.Quit
'Set ExcelSheet = Nothing
'objExcelApp.Quit
'Set objExcelApp = Nothing
''------------------------
'Ret = MsgBox ("Ôàéë Åêñåëü çàïèñàí íà äèñê. Îòêðûòü ôàéë ?", vbYesNo, "Open file")
'If Ret = vbYes Then
'CreateObject("WScript.Shell").Run sFileName, 1
'End If
''Sub SaveAs()
''
''Dim WorkbookName As String
''
''WorkbookName = Application.GetSaveAsFilename(, , , "Ñîõðàíèòü ôàéë êàê ...")
''
''If Len(WorkbookName) = 0 Or WorkbookName = "False" Then Exit Sub 'ñëó÷àé îòìåíû
'
'ActiveWorkbook.SaveAs WorkbookName
'
'End Sub
'
'Dim objFSO, objRegExp, Path, objFolder, objItem
'Set objFSO = CreateObject("Scripting.FileSystemObject")
'Path = objFSO.GetAbsolutePathName("")
'Set objFolder = objFSO.GetFolder(Path)
'Set objRegExp = CreateObject("VBScript.RegExp")
'objRegExp.Global = True
'objRegExp.Multiline = True
'objRegExp.IgnoreCase = True
'objRegExp.Pattern = NameFile
'For Each objItem In objFolder.Files
' If objRegExp.Test(objItem.Name) = True Then
' WScript.Echo "ôàéë "&objItem.Name&" íàéäåí"
' End If
'Next
' objExcel.ActiveSheet.Range("a19:d19").Select
'Selection.EntireRow.Hidden = True
'strok = strok-1
'Selection.EntireRow.Hidden = True
'objExcel.ActiveSheet.Rows(19).EntireColumn.Hidden = True 'Ñêðûòü ñòðîêó

' objExcel.ActiveSheet.Range("a19:d19").Select
'Selection.EntireRow.Hidden = True
'strok = strok-1
'Selection.EntireRow.Hidden = True
'objExcel.ActiveSheet.Rows(19).EntireColumn.Hidden = True 'Ñêðûòü ñòðîêó

End Sub

Поделиться21Четверг, 10 января, 2013г. 13:54:22

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Sub OnClick(Byval Item)
Dim Sodergh_Izopro_Spirta_1,Uroven_pH_Rastvor_Osvetl_Katanki_1
Dim Sodergh_Izopro_Spirta_2,Uroven_pH_Rastvor_Osvetl_Katanki_2
Dim IRGAMENT_42,Uroven_pH_Rastvor_Voshenia,Rolkleen_D6005
Dim Uroven_pH_Emulsia,Jostkost,Elektroprovodnost
Dim Uroven_pH_Ohlaghdenie_Liteinogo_Kolesa,Index_Z,Time_Z

Sodergh_Izopro_Spirta_1 = HMIRuntime.Tags("@UA_Sodergh_Izopro_Spirta_Rastvor_Osvetl_Katanki_1").Read
Uroven_pH_Rastvor_Osvetl_Katanki_1 = HMIRuntime.Tags("@UA_Uroven_pH_Rastvor_Osvetl_Katanki_1").Read
Sodergh_Izopro_Spirta_2 = HMIRuntime.Tags("@UA_Sodergh_Izopro_Spirta_Rastvor_Osvetl_Katanki_2").Read
Uroven_pH_Rastvor_Osvetl_Katanki_2 = HMIRuntime.Tags("@UA_Uroven_pH_Rastvor_Osvetl_Katanki_2").Read
IRGAMENT_42 = HMIRuntime.Tags("@UA_IRGAMENT_42_Rastvor_Voshenia").Read
Uroven_pH_Rastvor_Voshenia = HMIRuntime.Tags("@UA_Uroven_pH_Rastvor_Voshenia").Read
Rolkleen_D6005 = HMIRuntime.Tags("@UA_Rolkleen_D6005_Emulsia").Read
Uroven_pH_Emulsia = HMIRuntime.Tags("@UA_Uroven_pH_Emulsia").Read
Jostkost = HMIRuntime.Tags("@UA_Jostkost_Ohlaghdenie_Liteinogo_Kolesa").Read
Elektroprovodnost = HMIRuntime.Tags("@UA_Elektroprovodnost_Emulsia").Read
Uroven_pH_Ohlaghdenie_Liteinogo_Kolesa = HMIRuntime.Tags("@UA_Uroven_pH_Ohlaghdenie_Liteinogo_Kolesa").Read
Index_Z = HMIRuntime.Tags("@UA_Index_Z").Read
Time_Z = HMIRuntime.Tags("@UA_Time_Z").Read

If Sodergh_Izopro_Spirta_1 < 4 Then
HMIRuntime.Trace vbCrLf
HMIRuntime.Trace "X<4"
HMIRuntime.Trace vbCrLf
End If

If Sodergh_Izopro_Spirta_1 > 5 Then
HMIRuntime.Trace vbCrLf
HMIRuntime.Trace "X>5"
HMIRuntime.Trace vbCrLf
End If

HMIRuntime.Tags("@UA_Index_Z").Write "OH1"
HMIRuntime.Tags("@UA_Time_Z").Write Now
HMIRuntime.Tags("@UA_Znachenie_Teh_Jidkost").Write Sodergh_Izopro_Spirta_1
HMIRuntime.Tags("@UA_Parametr_Teh_Jidkost_ID").Write -1
HMIRuntime.Tags("@UA_Parametr_Teh_Jidkost_Job").Write 6

End Sub

Поделиться22Четверг, 31 января, 2013г. 14:39:47

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

'=========================================================================

For m = 0 To (UBound(arr)-1)
S4 = arr (m,4)
S5 = arr (m,5)
HMIRuntime.Trace " S4 =_" & S4 & "_m=_"& m & vbCrLf
HMIRuntime.Trace " S5 =_" & S5 & "_m=_"& m & vbCrLf
If S4 = Null Then S4 = "" End If
If S5 = Null Then S5 = "" End If

HMIRuntime.Trace " S4 =_" & S4 & "_m=_"& m & vbCrLf
If S4 <> "" Then
S4 = Replace(S4,".",",")
S4 = CCur(S4)
HMIRuntime.Trace " S4 CCur= " & S4 & " m= "& m & vbCrLf
End If
If S5 <> "" Then
S5 = Replace(S5,".",",")
S5 = CCur(S5)
HMIRuntime.Trace " S5 CCur= " & S5 & " m= "& m & vbCrLf
End If

If S4 <> "" And S5 <> "" Or S4 <> Null And S5 <> Null Then
S6 = (S4+S5)/2
HMIRuntime.Trace " S6 =(S4+S5)/2 = " & S6 & " m= "& m & vbCrLf
End If
If S4 <> "" And S5 <> "" Or S4 <> Null And S5 <> Null Then
S18 = S4-S5
End if

If S6 = Null Then S6 = "" End If
If S18 = Null Then S18 = "" End If

If S6 <> "" Then
S6 = Round(S6,2)
HMIRuntime.Trace " S6 =Round(S6,2) = " & S6 & " m= "& m & vbCrLf
S6 = Replace(S6,",",".")
HMIRuntime.Trace " S6 =Replace(S6, = " & S6 & " m= "& m & vbCrLf
cm.CommandText = "UPDATE UA#Ispitanie_Katanki Set Diam_Kat ="& S6 & " WHERE ID =" & Int(arr(m,0))
cm.Execute
End If

If S18 <> "" Then
S18 = Round(S18,2)
S18 = Replace(S18,",",".")
cm.CommandText = "UPDATE UA#Ispitanie_Katanki Set Ovalnost ="& S18 & " WHERE ID =" & Int(arr(m,0))
cm.Execute
End If
Next

Поделиться23Пятница, 8 февраля, 2013г. 13:49:36

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

UARead

Function UARead (Byval UAName)
Dim rst, con , sqlstr
Dim m, n
Redim arr (0,0)
'HMIRuntime.Trace "rst.Fields.Count = " & rst.Fields.Count & vbCrLf
'Set con = CreateObject("ADODB.Connection")
'
'con.ConnectionString = "Provider=SQLOLEDB.1;Server=S01\WinCC;Database=CC_kamkat_11_06_03_14_01_48R;Trusted_Connection=yes"
'con.CursorLocation = 3
'con.Open
'
'
'
''__________________________________________________________
''Set rst = CreateObject("ADODB.Recordset")
''con = "Provider = SQLOLEDB;Initial Catalog = " & HMIRuntime.Tags("@DatasourceNameRT").Read _
'' & ";Data Source = 172.16.0.2\WinCC;Integrated Security = SSPI"
''
''__________________________________________________________
'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=master ;Data Source=.\WinCC"
'HMIRuntime.Trace Now & vbCrLf

Set rst = CreateObject("ADODB.Recordset")
'con = "Provider = SQLOLEDB;Initial Catalog = " & "CC_kamkat_12_08_24_16_17_33R" & ";Data Source = S01\WinCC;Integrated Security = SSPI"
con = "Provider = SQLOLEDB;Initial Catalog = " & HMIRuntime.Tags("@DatasourceNameRT").Read _
& ";Data Source = 172.16.1.20\WinCC;Integrated Security = SSPI"
'__________________________________________________________

rst.ActiveConnection = con
If Trim(UAName) <> "" Then
sqlstr = "SELECT * FROM ua#" & Trim(UAName) 'PLAVKI
Else
sqlstr = "SELECT * FROM ua#*"
End If

rst.Source = sqlstr
rst.Open
m = 0
While Not rst.EOF
m = m + 1
rst.MoveNext
Wend
'HMIRuntime.Trace Now & vbCrLf
n = 0
n = rst.Fields.Count
Redim arr(m,n)
m = 0
n = 0
rst.MoveFirst
While Not rst.EOF
'HMIRuntime.Trace "rst.Fields.Count = " & rst.Fields.Count & vbCrLf
For n = 0 To (rst.Fields.Count-1)
'HMIRuntime.Trace "m = " & CStr(m) & " n = " & CStr(n) & vbCrLf
arr(m,n) = rst.Fields(n).Value
Next
m = m + 1
rst.MoveNext
Wend
rst.Close
Set rst = Nothing
UARead = arr
End Function

Поделиться24Пятница, 8 февраля, 2013г. 13:55:24

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Function SumRash (Byval TegName,TimeStart1,TimeStop1 )

Dim Conn, RecSet, Command, n
Dim zapros
Dim Result
Dim k, summ, sred
Dim TimeStart,TimeStop
Dim ms,i,i1,ms1,q,q1
Dim SummAll,sred1,RashMin
Dim TimeSegmentMin
On Error Resume Next

TimeSegmentMin=CLng(TimeSegmentMin)
SummAll=CLng(SummAll)
RashMin=CLng(RashMin)

TimeStart = TimeStart1
TimeStop = TimeStop1
'=====================OPREDELENIE KOLICHESTVA MIN V PERIODE VREMENI======================
TimeSegmentMin = Abs(DateDiff("n",TimeStart1,TimeStop1))

'======================POPREVKA PO GRINVICGu=============================================
If Not TimeStop = "00-00-0000 00:00:00.000" Then
TimeStart1 = DateAdd("h", -6, TimeStart)
TimeStop1 = DateAdd("h", -6, TimeStop)
End If

'2012-07-01 05:00 SQL
'25.07.2012 16:18 WinCC
'==========================================================================================
Set Conn = CreateObject("ADODB.Connection")
Conn.ConnectionString = "Provider=WinCCOLEDBProvider.1;Catalog=CC_kamkat_12_08_24_16_17_33R;Data Source=S01\WinCC"
Conn.CursorLocation = 3
Conn.Open
Set RecSet = CreateObject("ADODB.Recordset")
Set Command = CreateObject("ADODB.Command")
Command.CommandType = 1
Set Command.ActiveConnection = Conn
'================FORMIROVANIE DATYI DLYA SQL ZAPROSA====================================
TimeStart = Year(TimeStart1) & "-" & Month(TimeStart1) & "-" & Day(TimeStart1) & " "& Hour(TimeStart1) & ":"& Minute(TimeStart1) & ":"& Second(TimeStart1) & ".000"
TimeStop = Year(TimeStop1) & "-" & Month(TimeStop1) & "-" & Day(TimeStop1) & " "& Hour(TimeStop1) & ":"& Minute(TimeStop1) & ":"& Second(TimeStop1) & ".000"
'=======================================================================================
zapros = "Tag:R,"&TegName&",'"&TimeStart&"','"&TimeStop&"'"

Command.CommandText = zapros
Set RecSet = Command.Execute
RecSet.MoveFirst
Result = RecSet.Fields(2).Value
HMIRuntime.Trace "TimeSegmentMin= " & TimeSegmentMin & vbCrLf
'======OPREDELYAYU KOL ZAPISEYI V PROMEGHUTKE VREMENI=======================================
k=0
Do While Not RecSet.EOF

If RecSet.Fields(2).Value > 0 Then
k=k+1

End If
RecSet.MoveNext
Loop
'======================OPREDELENIE KOLICHESTVA CIKLOV=====================================
i1 = k / TimeSegmentMin
i = Int( k / TimeSegmentMin)
q = Int(k/i1)
'========================================================================================

If k > 0 Then
RecSet.MoveFirst
Result = RecSet.Fields(2).Value
SummAll=0
sred1=0
For ms1 = 1 To q

summ =0
RashMin = 0
For ms = 1 To i
If RecSet.Fields(2).Value > 0 Then
summ = summ + (RecSet.Fields(2)/60)
RecSet.MoveNext
End If
Next

sred1 = summ / i
SummAll = Round(SummAll+sred1,3)

Next
End If
'================================================================================================

RecSet.Close
Set RecSet = Nothing
Set Command = Nothing
Conn.Close
Set Conn = Nothing

SumRash = SummAll

'HMIRuntime.Trace " SummAll = " & SummAll & vbCrLf
End Function

Поделиться25Пятница, 8 февраля, 2013г. 15:03:42

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

Function UARead (Byval UAName)
Dim rst, con , sqlstr
Dim m, n
Redim arr (0,0)

Set rst = CreateObject("ADODB.Recordset")
con = "Provider = SQLOLEDB;Initial Catalog = CC_kamkat_12_08_24_16_17_33R;Data Source = S01\WinCC;Integrated Security = SSPI"
'__________________________________________________________

rst.ActiveConnection = con
If Trim(UAName) <> "" Then
sqlstr = "SELECT * FROM ua#" & Trim(UAName) 'PLAVKI
Else
sqlstr = "SELECT * FROM ua#*"
End If
rst.Source = sqlstr
rst.Open
m = 0
While Not rst.EOF
m = m + 1
rst.MoveNext
Wend
n = 0
n = rst.Fields.Count
Redim arr(m,n)
m = 0
n = 0
rst.MoveFirst
While Not rst.EOF
'HMIRuntime.Trace "rst.Fields.Count = " & rst.Fields.Count & vbCrLf
For n = 0 To (rst.Fields.Count-1)
'HMIRuntime.Trace "m = " & CStr(m) & " n = " & CStr(n) & vbCrLf
arr(m,n) = rst.Fields(n).Value
Next
m = m + 1
rst.MoveNext
Wend
rst.Close
Set rst = Nothing

UARead = arr
End Function

Поделиться26Четверг, 14 февраля, 2013г. 14:14:25

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

'=================================================================================================
'============================SUMMARNIY RASHOD (GAZA/VOZDUHA/...) PO ARH.TEGU======================
'=================================================================================================

Function SumRash (Byval TegName,TimeStart1,TimeStop1 )
Dim Conn, RecSet, Command, n
Dim zapros
Dim Result
Dim k, summ, sred
Dim TimeStart,TimeStop
Dim ms,i,i1,ms1,q,q1
Dim SummAll,sred1,RashMin
Dim TimeSegmentMin
Dim TimeMin1,TimeMin2

'On Error Resume Next

TimeSegmentMin=CLng(TimeSegmentMin)
SummAll=CLng(SummAll)
RashMin=CLng(RashMin)

TimeStart = TimeStart1
TimeStop = TimeStop1
'=====================OPREDELENIE KOLICHESTVA MIN V PERIODE VREMENI======================
TimeSegmentMin = Abs(DateDiff("n",TimeStart1,TimeStop1))

'======================POPRAVKA PO GRINVICGu=============================================
If Not TimeStop = "00-00-0000 00:00:00.000" Then
TimeStart1 = DateAdd("h", -6, TimeStart)
TimeStop1 = DateAdd("h", -6, TimeStop)
End If

'2012-07-01 05:00 SQL
'25.07.2012 16:18 WinCC
'==========================================================================================
Set Conn = CreateObject("ADODB.Connection")
Conn.ConnectionString = "Provider=WinCCOLEDBProvider.1;Catalog=CC_kamkat_12_08_24_16_17_33R;Data Source=S01\WinCC"
Conn.CursorLocation = 3
Conn.Open
Set RecSet = CreateObject("ADODB.Recordset")
Set Command = CreateObject("ADODB.Command")
Command.CommandType = 1
Set Command.ActiveConnection = Conn
'================FORMIROVANIE DATYI DLYA SQL ZAPROSA====================================
TimeStart = Year(TimeStart1) & "-" & Month(TimeStart1) & "-" & Day(TimeStart1) & " "& Hour(TimeStart1) & ":"& Minute(TimeStart1) & ":"& Second(TimeStart1) & ".000"
TimeStop = Year(TimeStop1) & "-" & Month(TimeStop1) & "-" & Day(TimeStop1) & " "& Hour(TimeStop1) & ":"& Minute(TimeStop1) & ":"& Second(TimeStop1) & ".000"
'========================ZAPROS===============================================================
zapros = "Tag:R,"&TegName&",'"&TimeStart&"','"&TimeStop&"'"
HMIRuntime.Trace " zapros = " & zapros & vbCrLf
Command.CommandText = zapros
Set RecSet = Command.Execute
RecSet.MoveFirst
'=============================================

TimeMin1 = Minute(RecSet.Fields(1))
TimeMin2 = TimeMin1
summ = 0
k = 0
sred1 = 0
SummAll = 0
i = 0
Do While Not RecSet.EOF
TimeMin1 = Minute(RecSet.Fields(1))
If RecSet.Fields(2) < 0 Then
HMIRuntime.Trace " Tag " & RecSet.Fields(0) & " Fields(1) " & RecSet.Fields(1) & " Fields(2) " & RecSet.Fields(2) & vbCrLf
End If

If TimeMin1 = TimeMin2 Then
summ = summ + Round((RecSet.Fields(2)/60),3)
k = k+1

Else
i = i+1
k = k+1
summ = summ + Round((RecSet.Fields(2)/60),3)
sred1 = summ / k
'HMIRuntime.Trace " sred1 " & sred1 & vbCrLf
SummAll = SummAll+sred1
TimeMin2 = TimeMin1
summ = 0
k=0
If sred1 < 0 Then
HMIRuntime.Trace " Tag " & RecSet.Fields(0) & " Fields(1) " & RecSet.Fields(1) & " Fields(2) " & RecSet.Fields(2) & vbCrLf

End If

End If

RecSet.MoveNext

Loop
'HMIRuntime.Trace " sred1 " & sred1 & vbCrLf
HMIRuntime.Trace " i =" & i & vbCrLf
'================================================================================================

RecSet.Close
Set RecSet = Nothing
Set Command = Nothing
Conn.Close
Set Conn = Nothing

SumRash = SummAll

'HMIRuntime.Trace " SummAll = " & SummAll & vbCrLf
End Function

'================================================================================================
'==========SUMMARNOE KOLICHESTVO VREMENI OTKRITOIY DVERI V MINUTAH===============================
'================================================================================================

Function DoorOpenMin (Byval NomPlav)

Dim Conn, RecSet, Command, n
Dim zapros
Dim TimeStart,TimeStop
Dim TimeSegmentMin
Dim m
Dim arrZagruz
Dim TimeStart1,TimeStop1
Dim TimeOpen,Time1,Time0,SummTime

On Error Resume Next

arrZagruz = UARead ("Zagruzka")
For m = 0 To (UBound(arrZagruz)-1)
If arrZagruz(m,2) = NomPlav Then
TimeStart1 = arrZagruz(m,29)
TimeStop1 = arrZagruz(m,30)
End If

'======================POPRAVKA PO GRINVICGu=============================================
If Not TimeStop = "00-00-0000 00:00:00.000" Then
TimeStart1 = DateAdd("h", -6, TimeStart)
TimeStop1 = DateAdd("h", -6, TimeStop)
End If

'2012-07-01 05:00 SQL
'25.07.2012 16:18 WinCC
'==========================================================================================
Set Conn = CreateObject("ADODB.Connection")
Conn.ConnectionString = "Provider=WinCCOLEDBProvider.1;Catalog=CC_kamkat_12_08_24_16_17_33R;Data Source=S01\WinCC"
Conn.CursorLocation = 3
Conn.Open
Set RecSet = CreateObject("ADODB.Recordset")
Set Command = CreateObject("ADODB.Command")
Command.CommandType = 1
Set Command.ActiveConnection = Conn
'================FORMIROVANIE DATYI DLYA SQL ZAPROSA====================================
TimeStart = Year(TimeStart1) & "-" & Month(TimeStart1) & "-" & Day(TimeStart1) & " "& Hour(TimeStart1) & ":"& Minute(TimeStart1) & ":"& Second(TimeStart1) & ".000"
TimeStop = Year(TimeStop1) & "-" & Month(TimeStop1) & "-" & Day(TimeStop1) & " "& Hour(TimeStop1) & ":"& Minute(TimeStop1) & ":"& Second(TimeStop1) & ".000"
'========================ZAPROS===============================================================
zapros = "Tag:R,273,'"&TimeStart&"','"&TimeStop&"'"
'HMIRuntime.Trace " zapros = " & zapros & vbCrLf
Command.CommandText = zapros
Set RecSet = Command.Execute
RecSet.MoveFirst

Do While Not RecSet.EOF
TimeOpen = 0
For m =1 To 2
If RecSet.Fields(2)= "1" Then
Time1 = RecSet.Fields(1)
End If
If RecSet.Fields(2)= "0" Then
Time0 = RecSet.Fields(1)
End If
RecSet.MoveNext
Next
TimeOpen = Abs(DateDiff("n",Time1,Time0))
SummTime = SummTime + TimeOpen

Loop

RecSet.Close
Set RecSet = Nothing
Set Command = Nothing
Conn.Close
Set Conn = Nothing

DoorOpenMin = SummTime

'HMIRuntime.Trace " SummAll = " & SummAll & vbCrLf
End Function

'================================================================================================
'=============KOLICHESTVO OTKRIYVANIIY DVERI ZA PERIOD ZAGRUZKI==================================
'================================================================================================

Function DoorOpenNum (Byval NomPlav)

Dim Conn, RecSet, Command, n
Dim zapros
Dim TimeStart,TimeStop
Dim m,k
Dim arrZagruz
Dim TimeStart1,TimeStop1
Dim TimeOpen,Time1,Time0,SummTime

On Error Resume Next

arrZagruz = UARead ("Zagruzka")
For m = 0 To (UBound(arrZagruz)-1)
If arrZagruz(m,2) = NomPlav Then
TimeStart1 = arrZagruz(m,29)
TimeStop1 = arrZagruz(m,30)
End If
Next

TimeStart = TimeStart1
TimeStop = TimeStop1
'======================POPRAVKA PO GRINVICGu=============================================
If Not TimeStop = "00-00-0000 00:00:00.000" Then
TimeStart1 = DateAdd("h", -6, TimeStart)
TimeStop1 = DateAdd("h", -6, TimeStop)
End If

'2012-07-01 05:00 SQL
'25.07.2012 16:18 WinCC
'==========================================================================================
Set Conn = CreateObject("ADODB.Connection")
Conn.ConnectionString = "Provider=WinCCOLEDBProvider.1;Catalog=CC_kamkat_12_08_24_16_17_33R;Data Source=S01\WinCC" '==="& HMIRuntime.Tags ("@DatasourceNameRT").Read & "
Conn.CursorLocation = 3
Conn.Open
Set RecSet = CreateObject("ADODB.Recordset")
Set Command = CreateObject("ADODB.Command")
Command.CommandType = 1
Set Command.ActiveConnection = Conn
'================FORMIROVANIE DATYI DLYA SQL ZAPROSA====================================
TimeStart = Year(TimeStart1) & "-" & Month(TimeStart1) & "-" & Day(TimeStart1) & " "& Hour(TimeStart1) & ":"& Minute(TimeStart1) & ":"& Second(TimeStart1) & ".000"
TimeStop = Year(TimeStop1) & "-" & Month(TimeStop1) & "-" & Day(TimeStop1) & " "& Hour(TimeStop1) & ":"& Minute(TimeStop1) & ":"& Second(TimeStop1) & ".000"
'========================ZAPROS===============================================================
zapros = "Tag:R,273,'"&TimeStart&"','"&TimeStop&"'"
Command.CommandText = zapros
Set RecSet = Command.Execute
RecSet.MoveFirst
k=0
Do While Not RecSet.EOF

For m =1 To 2
If RecSet.Fields(2)= "1" Then
k=k+1
End If
RecSet.MoveNext
Next
Loop

RecSet.Close
Set RecSet = Nothing
Set Command = Nothing
Conn.Close
Set Conn = Nothing

DoorOpenNum = k

'HMIRuntime.Trace " SummAll = " & SummAll & vbCrLf
End Function

Поделиться27Пятница, 15 февраля, 2013г. 14:38:00

Автор: X1
Участник
Зарегистрирован: Четверг, 20 декабря, 2012г.
Приглашений: 0
Сообщений: 24
Провел на форуме:
1 час 53 минуты
Последний визит:
Вторник, 4 февраля, 2014г. 12:27:15

'=================================================================================================
'============================SUMMARNIY RASHOD (GAZA/VOZDUHA/...) PO ARH.TEGU======================
'=================================================================================================

Function SumRash (Byval TegName,Byval TimeStart1,Byval TimeStop1 )
Dim Conn, RecSet, Command, n
Dim zapros
Dim Result
Dim k, summ, sred
Dim TimeStart,TimeStop
Dim ms,i,i1,ms1,q,q1
Dim SummAll,sred1,RashMin
Dim TimeSegmentMin
Dim TimeMin1,TimeMin2
Dim SummAll1
Dim s

'On Error Resume Next

TimeSegmentMin=CLng(TimeSegmentMin)
SummAll=CLng(SummAll)
RashMin=CLng(RashMin)

TimeStart = TimeStart1
TimeStop = TimeStop1
'=====================OPREDELENIE KOLICHESTVA MIN V PERIODE VREMENI======================
TimeSegmentMin = Abs(DateDiff("n",TimeStart1,TimeStop1))

'======================POPRAVKA PO GRINVICGu=============================================
If Not TimeStop = "00-00-0000 00:00:00.000" Then
TimeStart1 = DateAdd("h", -6, TimeStart)
TimeStop1 = DateAdd("h", -6, TimeStop)
End If

'2012-07-01 05:00 SQL
'25.07.2012 16:18 WinCC
'==========================================================================================
Set Conn = CreateObject("ADODB.Connection")
Conn.ConnectionString = "Provider=WinCCOLEDBProvider.1;Catalog=CC_kamkat_12_08_24_16_17_33R;Data Source=S01\WinCC"
Conn.CursorLocation = 3
Conn.Open
Set RecSet = CreateObject("ADODB.Recordset")
Set Command = CreateObject("ADODB.Command")
Command.CommandType = 1
Set Command.ActiveConnection = Conn
'================FORMIROVANIE DATYI DLYA SQL ZAPROSA====================================
TimeStart = Year(TimeStart1) & "-" & Month(TimeStart1) & "-" & Day(TimeStart1) & " "& Hour(TimeStart1) & ":"& Minute(TimeStart1) & ":"& Second(TimeStart1) & ".000"
TimeStop = Year(TimeStop1) & "-" & Month(TimeStop1) & "-" & Day(TimeStop1) & " "& Hour(TimeStop1) & ":"& Minute(TimeStop1) & ":"& Second(TimeStop1) & ".000"
'========================ZAPROS===============================================================
zapros = "Tag:R,"&TegName&",'"&TimeStart&"','"&TimeStop&"'"
HMIRuntime.Trace " zapros = " & zapros & vbCrLf
Command.CommandText = zapros
Set RecSet = Command.Execute
RecSet.MoveFirst
'=============================================

TimeMin1 = Minute(RecSet.Fields(1))
TimeMin2 = TimeMin1
sred1 = 0
SummAll = 0
i = 0
s = 0
Do While Not RecSet.EOF

If RecSet.Fields(2) < 0 Then
HMIRuntime.Trace " Tag " & RecSet.Fields(0) & " Fields(1) " & RecSet.Fields(1) & " Fields(2) " & RecSet.Fields(2) & vbCrLf
End If

TimeMin1 = Minute(RecSet.Fields(1))

If TimeMin1 = TimeMin2 Then
summ = summ + RecSet.Fields(2)/60
k = k+1

Else
i = i+1
k = k+1
summ = summ + RecSet.Fields(2)/60
sred1 = summ / k
SummAll = SummAll + sred1
TimeMin2 = TimeMin1
summ = 0
k=0

End If

RecSet.MoveNext

Loop

's = 0.0028848 * TimeSegmentMin
'HMIRuntime.Trace " s " & s & vbCrLf
'SummAll = SummAll * s

'HMIRuntime.Trace k & "-"
'HMIRuntime.Trace " [ " & i & " ] " & vbCrLf
'HMIRuntime.Trace " SummAll = " & SummAll & " min " & i & vbCrLf
'HMIRuntime.Trace " i " & i & vbCrLf
'HMIRuntime.Trace " SummAll = " & SummAll & " min " & i & vbCrLf
'HMIRuntime.Trace " sred1 " & sred1 & vbCrLf
HMIRuntime.Trace vbCrLf
HMIRuntime.Trace " i =" & i & vbCrLf
'================================================================================================