why doesn't markros start in vba excel?

I suggest you do an on-line repair of your office installation, I suspect something is wrong with your setup.

https://support.microsoft.com/en-us/office/repair-an-office-application-7821d4b6-7c1d-4205-aa0e-a6b40c5bb88b

sergey989 

Cannot remove microsoft forms

but check from Microsoft Office 16.0 Object library removed after closing excel file

how do i add new sheet with creat new mounth and new year macros

Public Sub CreateCalcsheet_click()

Public Sub CreateYearsheet_click()

sergey989 Any Excel VBA project must have these checked:

Looks like yours does not have the Microsoft Office 16.0 Object library checked. You should check its box.

JKPieterse 

how do we remake the program so
new year month will be added by pressing button on page настройки?


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х листов. За снятием ограничений обратитесь к разработчику: email address removed for privacy reasons, +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 & "За продлением лицензии обратитесь к разработчику: email address removed for privacy reasons, +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


Private Sub CreateYearsheet(ByVal s_month As String, ByVal s_year As String)

Dim oOpt As Worksheet
Dim end_day_col%, beg_day_col%, tgt_row%, tgt_col%, end_ras_row%

Set MonthNum = New Collection
MonthNum.Add "1", "январь": MonthNum.Add "2", "февраль": MonthNum.Add "3", "март": MonthNum.Add "4", "апрель"
MonthNum.Add "5", "май": MonthNum.Add "6", "июнь": MonthNum.Add "7", "июль": MonthNum.Add "8", "август"
MonthNum.Add "9", "сентябрь": MonthNum.Add "10", "октябрь": MonthNum.Add "11", "ноябрь": MonthNum.Add "12", "декабрь"

Set MonthName = New Collection
MonthName.Add "январь", "1": MonthName.Add "февраль", "2": MonthName.Add "март", "3": MonthName.Add "апрель", "4"
MonthName.Add "май", "5": MonthName.Add "июнь", "6": MonthName.Add "июль", "7": MonthName.Add "август", "8"
MonthName.Add "сентябрь", "9": MonthName.Add "октябрь", "10": MonthName.Add "ноябрь", "11": MonthName.Add "декабрь", "12"

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) = "Декабрь"

tbl_start = 4
i_year = CInt(s_year)
i_month = CInt(MonthNum(s_month))
s_month = IIf(Len(s_month) = 1, "0" & s_month, s_month)
i_count = i_end - i_beg + 1

sht_name = LCase("итоги " & s_year)
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = sht_name

Set oOpt = Sheets(cs_opt): oOpt.Activate
ras_beg = 5: ras_end = oOpt.Cells(Rows.Count, oOpt.Range("header").Column).End(xlUp).Row: ras_count = ras_end - ras_beg + 1
doh_beg = 5: doh_end = oOpt.Cells(Rows.Count, oOpt.Range("header2").Column).End(xlUp).Row: doh_count = doh_end - doh_beg + 1

With Sheets(sht_name)

.Range("C1").Value = "Доходы и расходы бюджета за " & s_year & " год"
.Range("C1").Font.Bold = True
.Range("C1").Font.Size = 16
.Range("C1:F1").Merge
.Rows(1).RowHeight = 22
.Range("C1:F1").HorizontalAlignment = xlCenter

.Names.Add Name:="s_mark", RefersToR1C1:="='" & .Name & "'!R" & 1 & "C" & 2
.Range("B1").Value = sht_name
With .Range("B1").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With

'====ДОХОД====
'Перечень статей
tgt_col = 1: tgt_row = 9: ras_header_row = tgt_row
Call add_list_block(Sheets(.Name), "доходов", "tbl_income", doh_beg, doh_end, doh_count, tgt_row, tgt_col, end_ras_row, "year")
'Итоги по всем строкам
tgt_col = 8: tgt_row = .Range("C" & .Rows.Count).End(xlUp).Row + 2
Call add_total_rows(Sheets(.Name), i_year, i_month, s_year, s_month, _
tgt_row, tgt_col, ras_header_row, beg_day_col, end_day_col, _
"Общий итог месяц", "Общий итог полугодие", "tbl_income", "all", "year")
'Факт СУММА
.Range("F" & ras_header_row + 2 & ":F" & end_ras_row).Formula = _
"=SUM(" & get_col_name(beg_day_col) & ras_header_row + 2 & ":" & get_col_name(end_day_col) & ras_header_row + 2 & ")"

'Метки
.Names.Add Name:="cl_first", RefersToR1C1:="='" & .Name & "'!R" & ras_header_row & "C" & beg_day_col
.Names.Add Name:="cl_last", RefersToR1C1:="='" & .Name & "'!R" & ras_header_row & "C" & end_day_col

'====РАСХОД====
'Перечень статей
tgt_col = 1: tgt_row = tgt_row + 5: ras_header_row = tgt_row
Call add_list_block(Sheets(.Name), "расходов", "tbl_cons", ras_beg, ras_end, ras_count, tgt_row, tgt_col, end_ras_row, "year")
'Итоги по всем строкам
tgt_col = 8: tgt_row = .Range("C" & .Rows.Count).End(xlUp).Row + 2
Call add_total_rows(Sheets(.Name), i_year, i_month, s_year, s_month, _
tgt_row, tgt_col, ras_header_row, beg_day_col, end_day_col, _
"Общий итог месяц", "Общий итог полугодие", "tbl_cons", "all", "year")
'Факт СУММА
.Range("F" & ras_header_row + 2 & ":F" & end_ras_row).Formula = _
"=SUM(" & get_col_name(beg_day_col) & ras_header_row + 2 & ":" & get_col_name(end_day_col) & ras_header_row + 2 & ")"

'====ИТОГОВАЯ ТАБЛИЦА====
tgt_row = 3: tgt_col = 3
.Cells(tgt_row, tgt_col - 1).Value = "Сравнение итогов"
.Cells(tgt_row, tgt_col - 1).Font.Bold = True
.Cells(tgt_row, tgt_col - 1).Font.Size = 14
.Cells(tgt_row, tgt_col - 1).HorizontalAlignment = xlCenter
.Range(.Cells(tgt_row, tgt_col - 1), .Cells(tgt_row, tgt_col + 3)).Merge
tgt_row = tgt_row + 1
.Range(.Cells(tgt_row, tgt_col - 1), .Cells(tgt_row, tgt_col)).Merge
.Cells(tgt_row, tgt_col + 1).Value = "Доход"
.Cells(tgt_row, tgt_col + 2).Value = "Расход"
.Cells(tgt_row, tgt_col + 3).Value = "Разница"
.Range(.Cells(tgt_row, tgt_col + 1), .Cells(tgt_row, tgt_col + 3)).Font.Bold = True
.Range(.Cells(tgt_row, tgt_col + 1), .Cells(tgt_row, tgt_col + 3)).Font.Size = 11
tgt_row = tgt_row + 1
.Cells(tgt_row, tgt_col - 1).Value = "План": .Range(.Cells(tgt_row, tgt_col - 1), .Cells(tgt_row, tgt_col)).Merge
tgt_row = tgt_row + 1
.Cells(tgt_row, tgt_col - 1).Value = "Факт": .Range(.Cells(tgt_row, tgt_col - 1), .Cells(tgt_row, tgt_col)).Merge
tgt_row = tgt_row + 1
.Cells(tgt_row, tgt_col - 1).Value = "Отклон.": .Range(.Cells(tgt_row, tgt_col - 1), .Cells(tgt_row, tgt_col)).Merge
.Range(.Cells(tgt_row, tgt_col + 1), .Cells(tgt_row, tgt_col + 3)).Formula = _
"=" & get_col_name(tgt_col + 1) & tgt_row - 1 & "-" & get_col_name(tgt_col + 1) & tgt_row - 2
.Range(.Cells(tgt_row - 2, tgt_col + 1), .Cells(tgt_row, tgt_col + 3)).HorizontalAlignment = xlRight
.Range(.Cells(tgt_row - 2, tgt_col + 1), .Cells(tgt_row, tgt_col + 3)).NumberFormat = "#,##0"
.Range(.Cells(3, tgt_col - 1), .Cells(4, tgt_col + 3)).Interior.Color = 13434879
Call setBorders(Sheets(.Name), .Range(.Cells(3, tgt_col - 1), .Cells(tgt_row, tgt_col + 3)).Address(0, 0), xlThin, False, True)

'разница
.Range("F" & tgt_row - 2 & ":F" & tgt_row - 1).Formula = "=D" & tgt_row - 2 & "-E" & tgt_row - 2
'Доход План
.Range("D5").Formula = "=income_plan"
'Доход Факт
.Range("D6").Formula = "=income_fact"
'Расход План
.Range("E5").Formula = "=consum_plan"
'Расход Факт
.Range("E6").Formula = "=consum_fact"

.Columns("A").Hidden = True

.Activate
.Range("H1").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 80

End With

Set oOpt = Nothing

End Sub

sergey989 

Clear the check box for this reference, then click OK.

Hopefully, the problem will disappear.

how do i resove it where to find refercnces missing update wps office 3.0 object library (beta)?