Архитектура Аудит Военная наука Иностранные языки Медицина Металлургия Метрология
Образование Политология Производство Психология Стандартизация Технологии


Программный код, заполняющий таблицы паспорта программы энергосбережения данными о холодной воде



 

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; Нарушение авторского права страницы


lektsia.com 2007 - 2024 год. Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав! (0.042 с.)
Главная | Случайная страница | Обратная связь