Код: (vb)

Public Sub count_sheet()

On Error GoTo Error

ActiveWorkbook.Application.DisplayAlerts = False
Application.ScreenUpdating = False



Dim m7 As Long
Dim mday As Date


For m7 = 17 To 108

' Столбец L и М

If ActiveSheet.Name = "Время бурения" Then
ElseIf ActiveSheet.Name = "План" Then
ElseIf ActiveSheet.Name = "Адреса" Then
Else
ActiveSheet.Cells(m7, 9).NumberFormat = "dd/mm/yy h:mm;@"
ActiveSheet.Cells(m7, 20).NumberFormat = "0.00"
ActiveSheet.Cells(m7, 21).NumberFormat = "0.00"
ActiveSheet.Cells(m7, 22).NumberFormat = "0.00_ ;-0.00 "
ActiveSheet.Cells(m7, 9).ShrinkToFit = True
End If


If ActiveSheet.Name = "Время бурения" Then
ElseIf ActiveSheet.Name = "План" Then
ElseIf ActiveSheet.Name = "Адреса" Then
ElseIf ActiveSheet.Name = "01" Then
'ElseIf ActiveSheet.Cells(m7, 12).Interior.ColorIndex = 36 Then
ElseIf CDate(ActiveSheet.Range("N3").Value) <> CDate(Worksheets("План").Cells(m7, 13).Value) And ActiveSheet.Cells(m7, 12).Value > 0 Then
ActiveSheet.Range("M" & m7).Formula = "=IF(L" & m7 & ">=" & " '" & Worksheets(ActiveSheet.Index - 1).Name & "'" & "!L" & m7 & ",L" & m7 & "-" & "'" & Worksheets(ActiveSheet.Index - 1).Name & "'" & "!L" & m7 & ",L" & m7 & ")"
ElseIf CDate(ActiveSheet.Range("N3").Value) = CDate(Worksheets("План").Cells(m7, 13).Value) Then
ActiveSheet.Cells(m7, 13).Value = Worksheets("План").Cells(m7, 12).Value
ElseIf ActiveSheet.Cells(m7, 6).Text <> Worksheets(ActiveSheet.Index - 1).Cells(m7, 6).Text Then
ActiveSheet.Cells(m7, 13).Value = 0

ElseIf (CDate(ActiveSheet.Range("N3").Value) <> CDate(Worksheets("План").Cells(m7, 13).Value) Or CDate(ActiveSheet.Range("N3").Value) <> CDate(Worksheets("План").Cells(m7, 13).Value)) And ActiveSheet.Cells(m7, 12).Value > 0 Then
ActiveSheet.Range("M" & m7).Formula = "=IF(L" & m7 & ">=" & " '" & Worksheets(ActiveSheet.Index - 1).Name & "'" & "!L" & m7 & ",L" & m7 & "-" & "'" & Worksheets(ActiveSheet.Index - 1).Name & "'" & "!L" & m7 & ",L" & m7 & ")"

If CDate(ActiveSheet.Range("N3").Value) = CDate(Worksheets("План").Cells(m7, 13).Value) Then
ActiveSheet.Cells(m7, 13).Value = Worksheets("План").Cells(m7, 10).Value - Worksheets("План").Cells(m7, 11).Value
End If
If CDate(ActiveSheet.Range("N3").Value) = CDate(Worksheets("План").Cells(m7, 18).Value) Then
ActiveSheet.Cells(m7, 13).Value = Worksheets("План").Cells(m7, 15).Value - Worksheets("План").Cells(m7, 16).Value
End If

Else
ActiveSheet.Cells(m7, 13).Value = vbNullText
End If

If ActiveCell.Address = Cells(m7, 6).Address Then
Call timecount
Else

End If

Next m7


'Срезка технологическая
For m7 = 17 To 108
For i = 1 To Worksheets.Count - 3
If Worksheets("План").Cells(m7, 13).Value = vbNullText Then

Else
If ActiveSheet.Name = "План" And CDate(Worksheets(i).Range("N3").Value) = CDate(Worksheets("План").Cells(m7, 13).Value) Then
Worksheets("План").Cells(m7, 12).Value = Worksheets("План").Cells(m7, 10).Value - Worksheets("План").Cells(m7, 11).Value
Worksheets("План").Cells(m7, 9).Value = Worksheets(i).Cells(m7, 6).Value
Worksheets(i).Cells(m7, 12).Value = Worksheets("План").Cells(m7, 10).Value
Worksheets(i).Cells(m7, 13).Value = Worksheets("План").Cells(m7, 12).Value
Else

End If
End If

If Worksheets("План").Cells(m7, 18).Value = vbNullText Then

Else
If ActiveSheet.Name = "План" And CDate(Worksheets(i).Range("N3").Value) = CDate(Worksheets("План").Cells(m7, 18).Value) _
Then
Worksheets("План").Cells(m7, 17).Value = Worksheets("План").Cells(m7, 15).Value - Worksheets("План").Cells(m7, 16).Value
Worksheets("План").Cells(m7, 14).Value = Worksheets(i).Cells(m7, 6).Value
Worksheets(i).Cells(m7, 12).Value = Worksheets("План").Cells(m7, 15).Value
Worksheets(i).Cells(m7, 13).Value = Worksheets("План").Cells(m7, 17).Value
Else

End If
End If

Next i
Next m7

For m7 = 17 To 108
If ActiveSheet.Name = "План" Then
If Worksheets("План").Cells(m7, 13).Value > vbNullText Then
Else
Worksheets("План").Cells(m7, 9).Value = vbNullText
Worksheets("План").Cells(m7, 10).Value = vbNullText
Worksheets("План").Cells(m7, 11).Value = vbNullText
Worksheets("План").Cells(m7, 12).Value = vbNullText
End If


If Worksheets("План").Cells(m7, 18).Value > vbNullText Then
Else
Worksheets("План").Cells(m7, 14).Value = vbNullText
Worksheets("План").Cells(m7, 15).Value = vbNullText
Worksheets("План").Cells(m7, 16).Value = vbNullText
Worksheets("План").Cells(m7, 17).Value = vbNullText
End If
End If




Next m7



'-----------------------Аварийная срезка-----------------------------------'
'For m7 = 17 To 107
'For i = 1 To Worksheets.Count - 3
'If Worksheets("План").Cells(m7, 28).Value = vbNullText Then

'Else
'If ActiveSheet.Name = "План" And CDate(Worksheets(i).Range("N3").Value) = CDate(Worksheets("План").Cells(m7, 28).Value) _
'Then
'Worksheets("План").Cells(m7, 27).Value = Worksheets("План").Cells(m7, 26).Value - Worksheets("План").Cells(m7, 25).Value
'Worksheets("План").Cells(m7, 24).Value = Worksheets(i).Cells(m7, 6).Value
'Worksheets("План").Cells(m7, 29).Value = Worksheets(i).Cells(m7, 24).Value
'Else

'End If
'End If
'Next i
'Next m7

'For m7 = 17 To 107
'If ActiveSheet.Name = "План" Then
'If Worksheets("План").Cells(m7, 28).Value > vbNullText Then
'Else
'Worksheets("План").Cells(m7, 24).Value = vbNullText
'Worksheets("План").Cells(m7, 25).Value = vbNullText
'Worksheets("План").Cells(m7, 26).Value = vbNullText
'Worksheets("План").Cells(m7, 27).Value = vbNullText
'End If
'End If
'Next m7
'----------------------[Аварийная срезка]----------------------------------'


Error:
If Err.Number <> 0 Then
MsgBox Err.Description, , "Внимание!!!"
Err.Clear
Exit Sub
Else
End If

End Sub

=================================================
Не забываем оформлять листинги кодов тегами VBA Code[Администратор]

Я не могу приложить сам файл, это конфиденциальная информация.

Добрый день. Помогите разобраться.

При запуске файла выходит ошибка 440 - по таблице ошибок   VBA - 440 -это ошибка автоматизации.
Проблема в том что, не  у всех пользователей такое происходит.

Прилагаю скриншот ошибки. Может кто -то уже сталкивался .

The_Prist   Ваши комментарии самые грамотные.

Боже мой, ну прям заклевали.   

Смеяться не буду.
Приведу вам пример :
Некоторые свойства являются неизменяемыми, т.е. доступными только для чтения. Имеется ввиду, что значения свойства можно узнать но нельзя изменить.
для диапазона (объекта  Range) , состоящего из одной ячейки.....................
когда мы в коде пишем  Range ("")  указывается конкретная ячейка.
когда пишем  Cells () то как и можем указывать диапазон.

Хотя каждый предпочитает писать по своему.

при объявлении можно написать
 dim cell as range

 а наоборот не пишут     dim range as cell 

бу га га
 dim cell as range - объявляете переменную с именем "cell", которая имеет тип "range"
 dim range as cell - объявляете переменную с именем "range", которая имеет тип "cell" - ктож так пишет??? такая запись привед1т к  ошибке, потому что 1. "range" зарезервированное слово, нельзя присвоить такое имея переменной 2. нет типа "cell", есть объект Cells, который является наследником объекта Range.
И вообще нехорошо присваивать переменным имена зарезервированных слов

почитайте внимательно, именно об этом я писала.

Смеяться не буду.
Приведу вам пример :
Некоторые свойства являются неизменяемыми, т.е. доступными только для чтения. Имеется ввиду, что значения свойства можно узнать но нельзя изменить.
для диапазона (объекта  Range) , состоящего из одной ячейки.....................
когда мы в коде пишем  Range ("")  указывается конкретная ячейка.
когда пишем  Cells () то как и можем указывать диапазон.

Хотя каждый предпочитает писать по своему.

при объявлении можно написать
 dim cell as range

 а наоборот не пишут     dim range as cell 

Могу добавить еще информацию :  Cells  -  представляет объект
Range  - ячейку

Уважаемый знаток, это то-что нужно.
Потрясающе.

Спасибо вам большое.

 Дело в том, что есть сложности с  html.

А еще вариант какой нибудь есть ?

Спасибо, за совет.

Доброго времени суток коллеги.
Есть сложность в решении одной задачи.

В прилагаемом файле, реализована возможность отправки писем  из  Excel с помощью  Outlook.
Проблема заключается  в следующем, как можно прописать чтобы в теле письма информация выходила в виде таблички.
В данный момент, информация выходит в столбик.
Кто будет пробовать, в столбце адреса поставьте свой.

Добрый день.

При работе с  Excel было обнаружено интересное поведение программы.
На  принт-сервере слетели драйвера некоторых принтеров фирмы  HP.
В результате чего  возникало постоянное зависание в работе программ  Office.
Проблему решили :
1. Установка нужных драйверов на принт- сервер.
2. Переустановка офиса на клиентских машинах.

Пропишите для ячеек сразу что в них формат дата, в других формат число.
Я так делаю иногда.

Всем спасибо. Я разобралась.

Не помогло. Во время отладки эту строчку просто проскакивает.