почему программа не работает ?

[vitalyoleg]

почему программа не работает ?
помогите переделать что-бы заполнять поля ?

[Elixi]

Сообщение от vitalyoleg

почему программа не работает ?

А почему не обратиться к автору программы?

[Serge 007]

Сообщение от vitalyoleg

почему программа не работает ?

Потому что

"Пробный период использования программы истек. Ваши данные сохранены и будут доступны после продления лицензии. За продлением лицензии обратитесь к разработчику"

[vitalyoleg]

при запуске программы получаем ошибку

[vitalyoleg]

как переделать программу что-бы на странице настройка можно добавить год месяц

[vitalyoleg]

как изменить программу что-бы на странице настройка можно добавить год месяц

Attribute VB_Name = "Year"
Public Sub CreateYearsheet_click()
Dim b_groups_found As Boolean

Application.ReferenceStyle = xlA1

With Sheets(cs_opt)

i_beg = .Range("header").Row + 1
i_end = .Range("A" & Rows.Count).End(xlUp).Row
s_month = .Range("month").Value
s_year = .Range("year").Value
s_name = LCase("итоги" & " " & s_year)
b_find = False

If i_end >= i_beg And s_month <> "" And s_year <> "" Then

On Error Resume Next
Ans = Sheets(s_name).Name
If Err.Number = 0 Then b_find = True
Err.Clear
On Error GoTo 0

Ans = vbYes
If b_find Then
Ans = MsgBox("В книге уже присутствует лист учета """ & s_name & """." & vbCrLf & "Удалить его перед построением нового?", vbQuestion + vbYesNo, "Сообщение")
If Ans = vbYes Then
Application.DisplayAlerts = False
Sheets(s_name).Delete
Application.DisplayAlerts = True
On Error GoTo 0
End If
End If

If Ans = vbYes Then
If CDate(Now()) < activate_end Then
click_count = Sheets(cs_opt).Range("AD1").Value
If click_count <= 4 Then
Application.ScreenUpdating = False
click_count = click_count + 1
Sheets(cs_opt).Range("AD1").Value = click_count
Call CreateYearsheet(s_month, s_year)
b_groups_found = check_groups(s_month, s_year, "year")
If b_groups_found Then
Call AddGroupsToTbl(s_month, s_year, "tbl_income", "year")
Call AddGroupsToTbl(s_month, s_year, "tbl_cons", "year")
End If
Call add_button(Sheets(s_name), Sheets(s_name).Cells(1, 7), 80, 30, 5, 5, "RefreshYearData_click", "Обновить")
Call RefreshYearData_click
ThisWorkbook.Save
Application.ScreenUpdating = True
Else
Ans = MsgBox("В пробной версии программы нельзя создавать более 2х листов. За снятием ограничений обратитесь к разработчику: goryaninov@bk.ru, +79507094770 или на сайт excellab.ru", vbInformation + vbOKOnly, "Сообщение")
End If
Else
For Each sht In ThisWorkbook.Sheets
sht.Protect Password:="timesheet123"
If sht.Name <> "Настройки" Then sht.Visible = xlSheetVeryHidden
Next sht
ThisWorkbook.Save
Ans = MsgBox("Пробный период использования программы истек. Ваши данные сохранены и будут доступны после продления лицензии." & vbCrLf & "За продлением лицензии обратитесь к разработчику: goryaninov@bk.ru, +79507094770 или на сайт excellab.ru", vbInformation + vbOKOnly, "Пробный период использования истек")
' Ans = MsgBox("Ошибка импорта библиотеки Syshdwl64.dll", vbCritical + vbOKOnly, "Ошибка")
End If
End If

Else
Ans = MsgBox("Заполните обязательные поля:" & """категории расходов"", ""месяц"", ""год"".", vbInformation + vbOKOnly, "Сообщение")
End If

End With
End Sub
Public Sub RefreshYearData_click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Call RefreshYearData("auto")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub RefreshYearData(ByVal mode)

month_name(1) = "Январь": month_name(2) = "Февраль": month_name(3) = "Март"
month_name(4) = "Апрель": month_name(5) = "Май": month_name(6) = "Июнь": month_name(7) = "Июль"
month_name(8) = "Август": month_name(9) = "Сентябрь": month_name(10) = "Октябрь": month_name(11) = "Ноябрь": month_name(12) = "Декабрь"
CL_ID = "C"
Set oYear = ActiveSheet
On Error Resume Next
For i_month = 1 To 12
s_month = LCase(month_name(i_month))
s_year = Right(Range("s_mark").Value, 4)
sht_name = s_month & " " & s_year
Set oMn = Sheets(sht_name)
mn_beg = oMn.Range("tbl_income").Row + 2
mn_end = oMn.Range("consum_fact").Row - 1
If Err.Number = 0 Then
i_col = 7 + i_month
'---ДОХОДЫ
i_beg = oYear.Range("tbl_income").Row + 2
i_end = oYear.Range("income_fact").Row - 1
For i = i_beg To i_end
s_id = CStr(oYear.Range(CL_ID & i).Value)
If s_id <> "" Then
tgt_row = oMn.Range(CL_ID & mn_beg & ":" & CL_ID & mn_end).Find(s_id, , , xlWhole).Row
If Err.Number = 0 Then
oYear.Cells(i, i_col).Formula = "='" & oMn.Name & "'!F" & tgt_row 'Факт сумма по статье
Else
Err.Clear
End If
End If
Next i
'---РАСХОДЫ
i_beg = oYear.Range("tbl_cons").Row + 2
i_end = oYear.Range("consum_fact").Row - 1
For i = i_beg To i_end
s_id = CStr(oYear.Range(CL_ID & i).Value)
If s_id <> "" Then
tgt_row = oMn.Range(CL_ID & mn_beg & ":" & CL_ID & mn_end).Find(s_id, , , xlWhole).Row
If Err.Number = 0 Then
oYear.Cells(i, i_col).Formula = "='" & oMn.Name & "'!F" & tgt_row 'Факт сумма по статье
Else
Err.Clear
End If
End If
Next i
Else
Err.Clear
End If
Next i_month
Set oYear = Nothing
Set oMn = Nothing
On Error GoTo 0

End Sub

[MikeVol]

Вам же Чётко видно что и как:

[QUOTE За снятием ограничений обратитесь к разработчику: goryaninov@bk.ru, +79507094770 или на сайт excellab.ru" [/QUOTE]
Любите считать свои доходы полюбите оплатить разработчику за свои труды. Не всё же на шару бывает.