Архитектура Аудит Военная наука Иностранные языки Медицина Металлургия Метрология Образование Политология Производство Психология Стандартизация Технологии |
Программный код, заполняющий таблицы паспорта программы энергосбережения данными о холодной воде ⇐ ПредыдущаяСтр 9 из 9
Set AppExcel = New Excel.Application Set WBK = AppExcel.Application.Workbooks.Open(App.Path & " \Паспорт программы энергосбережения.xlsx" ) AppExcel.Application.Sheets(2).Select Set WordApp = New Word.Application Set DocWord = WordApp.Documents.Open(App.Path & " \Паспортпрограммыэнергосбережения.docx" ) Set WdRange6 = WordApp.ActiveDocument.Content WdRange6.Find.ClearFormatting WdRange6.Find.Text = " В стоимостном выражении, тыс. руб" WdRange6.Find.Execute Set wdtab7 = WdRange6.Tables(1) saq = 6 n = 8 Do While saq < 18 wdtab7.Cell(saq, 1).Select With WordApp.Application.Selection.Find .Text = " Итого по мероприятиям экономии электрической энергии" .Execute End With If WordApp.Application.Selection.Find.Found = True Then Exit Do End If n = n + 1 saq = saq + 1 Loop g = 0 Do While n < 18 wdtab7.Cell(n, 1).Select With WordApp.Application.Selection.Find .Text = " Итого по мероприятиям экономии тепловой энергии" .Execute End With If WordApp.Application.Selection.Find.Found = True Then Exit Do End If g = g + 1 n = n + 1 Loop f = 3 e = 0 Do While f < 13 wdtab7.Cell(n, f).Select AppExcel.Application.Range(" s20" ).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e), ", ", "." ))) End If f = f + 1 e = e + 1 wdtab7.Cell(n, f).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e), ", ", "." ))) End If f = f + 2 e = e + 2 wdtab7.Cell(n, f).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e), ", ", "." ))) End If f = f + 2 e = e + 2 Loop saq = 6 n = 10 Do While saq < 18 wdtab7.Cell(saq, 1).Select With WordApp.Application.Selection.Find .Text = " Итого по мероприятиям экономии электрической энергии" .Execute End With If WordApp.Application.Selection.Find.Found = True Then Exit Do End If n = n + 1 saq = saq + 1 Loop g = 0 Do While n < 36 wdtab7.Cell(n, 1).Select With WordApp.Application.Selection.Find .Text = " Всегопомероприятиям" .Execute End With If WordApp.Application.Selection.Find.Found = True Then Exit Do End If g = g + 1 n = n + 1 Loop f = 3 e = 0 wdtab7.Cell(n, f).Select AppExcel.Application.Range(" s23" ).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(AppExcel.Application.ActiveCell.Offset(g, e)) End If f = f + 3 e = e + 3 wdtab7.Cell(n, f).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(AppExcel.Application.ActiveCell.Offset(g, e)) End If f = f + 2 e = e + 2 wdtab7.Cell(n, f).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(AppExcel.Application.ActiveCell.Offset(g, e)) End If f = f + 3 e = e + 3 wdtab7.Cell(n, f).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(g, e).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(AppExcel.Application.ActiveCell.Offset(g, e)) End If Set WdRange7 = WordApp.ActiveDocument.Content WdRange7.Find.ClearFormatting WdRange7.Find.Text = " Значениецелевыхпоказателейпрограммы" WdRange7.Find.Execute Set wdtab8 = WdRange7.Tables(1) AppExcel.Application.Range(" a33" ).Select Do Until 1 = Val(AppExcel.Application.ActiveCell.Value) AppExcel.Application.ActiveCell.Offset(1, 0).Select Loop wdtab8.Cell(5, 4).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3), ", ", "." ))) End If WdRange7.Find.Execute Set wdtab9 = WdRange7.Tables(1) AppExcel.Application.Range(" a42" ).Select Do Until 1 = Val(AppExcel.Application.ActiveCell.Value) AppExcel.Application.ActiveCell.Offset(1, 0).Select Loop wdtab9.Cell(5, 4).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3), ", ", "." ))) End If WdRange7.Find.Execute Set wdtab10 = WdRange7.Tables(1) AppExcel.Application.Range(" a51" ).Select Do Until 1 = Val(AppExcel.Application.ActiveCell.Value) AppExcel.Application.ActiveCell.Offset(1, 0).Select Loop wdtab10.Cell(5, 4).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3), ", ", "." ))) End If WdRange7.Find.Execute Set wdtab11 = WdRange7.Tables(1) AppExcel.Application.Range(" a60" ).Select Do Until 1 = Val(AppExcel.Application.ActiveCell.Value) AppExcel.Application.ActiveCell.Offset(1, 0).Select Loop wdtab11.Cell(5, 4).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3), ", ", "." ))) End If WdRange7.Find.Execute Set wdtab12 = WdRange7.Tables(1) AppExcel.Application.Range(" a69" ).Select Do Until 1 = Val(AppExcel.Application.ActiveCell.Value) AppExcel.Application.ActiveCell.Offset(1, 0).Select Loop wdtab12.Cell(5, 4).Select If 0 = Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3).Value, ", ", "." )) Then WordApp.Application.Selection.TypeText Text: =" —" Else WordApp.Application.Selection.TypeText Text: =CStr(Val(Replace(AppExcel.Application.ActiveCell.Offset(0, 3), ", ", "." ))) End If Set WdRange8 = WordApp.ActiveDocument.Content WdRange8.Find.ClearFormatting WdRange8.Find.Text = " Итогопоэкономииэлектрическойэнергии" WdRange8.Find.Execute Set wdtab13 = WdRange8.Tables(1) saq = 6 n = 8 Do While saq < 18 wdtab13.Cell(saq, 1).Select With WordApp.Application.Selection.Find .Text = " Итого по экономии электрической энергии" .Execute End With If WordApp.Application.Selection.Find.Found = True Then Exit Do End If n = n + 1 saq = saq + 1 Loop g = 0 Do While n < 18 wdtab13.Cell(n, 1).Select With WordApp.Application.Selection.Find .Text = " Итого по экономии тепловой энергии" .Execute End With If WordApp.Application.Selection.Find.Found = True Then Exit Do End If g = g + 2 n = n + 1 Loop wdtab13.Cell(n, 3).Select AppExcel.Application.Range(" d84" ).Select WordApp.Application.Selection.TypeText Text: =CStr(AppExcel.Application.ActiveCell.Offset(g, 0)) wdtab13.Cell(n, 6).Select WordApp.Application.Selection.TypeText Text: =CStr(AppExcel.Application.ActiveCell.Offset(g, 3)) wdtab13.Cell(n, 10).Select WordApp.Application.Selection.TypeText Text: =CStr(AppExcel.Application.ActiveCell.Offset(g, 7)) saq = 6 n = 10 Do While saq < 18 wdtab13.Cell(saq, 1).Select With WordApp.Application.Selection.Find .Text = " Итого по экономии электрической энергии" .Execute End With If WordApp.Application.Selection.Find.Found = True Then Exit Do End If n = n + 1 saq = saq + 1 Loop saq = saq + 2 g = 0 Do While saq < 26 wdtab13.Cell(saq, 1).Select With WordApp.Application.Selection.Find .Text = " Итогопоэкономиитепловойэнергии" .Execute End With If WordApp.Application.Selection.Find.Found = True Then Exit Do End If saq = saq + 1 g = g + 2 n = n + 1 Loop Do While n < 36 wdtab13.Cell(n, 1).Select With WordApp.Application.Selection.Find .Text = " Всегопомероприятиям" .Execute End With If WordApp.Application.Selection.Find.Found = True Then Exit Do End If g = g + 2 n = n + 1 Loop wdtab13.Cell(n, 3).Select AppExcel.Application.Range(" d87" ).Select WordApp.Application.Selection.TypeText Text: =CStr(AppExcel.Application.ActiveCell.Offset(g, 0)) wdtab13.Cell(n, 10).Select WordApp.Application.Selection.TypeText Text: =CStr(AppExcel.Application.ActiveCell.Offset(g, 7)) WordApp.ActiveDocument.save WordApp.Quit True AppExcel.Application.ActiveWorkbook.save AppExcel.Application.ActiveWorkbook.Close |
Последнее изменение этой страницы: 2017-05-05; Просмотров: 418; Нарушение авторского права страницы