|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу. Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста". Название темы слишком короткое или не отражает сути вашего вопроса. Тема исчерпала себя, помните, один вопрос - одна тема Прочитайте правила и заново правильно создайте тему. |
|
Опции темы | Поиск в этой теме |
01.02.2023, 16:09 | #1 |
Пользователь
Регистрация: 18.10.2018
Сообщений: 25
|
почему программа не работает ?
почему программа не работает ?
помогите переделать что-бы заполнять поля ? |
01.02.2023, 22:39 | #2 |
Форумчанин
Регистрация: 10.05.2019
Сообщений: 164
|
|
02.02.2023, 10:36 | #3 | |
Участник клуба
Регистрация: 15.12.2009
Сообщений: 1,448
|
Потому что
Цитата:
Бесплатная помощь: www.excelworld.ru
Платная помощь: serge_007.planetaexcel@mail.ru https://yoomoney.ru: 41001419691823 |
|
02.02.2023, 11:57 | #4 |
Пользователь
Регистрация: 18.10.2018
Сообщений: 25
|
при запуске программы получаем ошибку
|
02.02.2023, 15:53 | #5 |
Пользователь
Регистрация: 18.10.2018
Сообщений: 25
|
как переделать программу что-бы на странице настройка можно добавить год месяц
|
02.02.2023, 15:57 | #6 |
Пользователь
Регистрация: 18.10.2018
Сообщений: 25
|
как изменить программу что-бы на странице настройка можно добавить год месяц
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 |
15.02.2023, 21:16 | #7 |
Пользователь
Регистрация: 19.07.2021
Сообщений: 21
|
Вам же Чётко видно что и как:
[QUOTE За снятием ограничений обратитесь к разработчику: goryaninov@bk.ru, +79507094770 или на сайт excellab.ru" [/QUOTE] Любите считать свои доходы полюбите оплатить разработчику за свои труды. Не всё же на шару бывает. |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Почему не работает программа? | blacktener | Общие вопросы C/C++ | 5 | 09.09.2013 09:37 |
почему не работает программа? | nazar_vol | Паскаль, Turbo Pascal, PascalABC.NET | 2 | 09.06.2013 19:55 |
Почему не работает программа? | forged | Паскаль, Turbo Pascal, PascalABC.NET | 1 | 12.03.2013 17:40 |
Почему не работает программа, что не так? | Демик | Паскаль, Turbo Pascal, PascalABC.NET | 9 | 17.07.2011 21:12 |
Почему программа на С++ не работает с локальным описанием массива, но работает с глобальным? | >>STINGER<< | Помощь студентам | 4 | 08.03.2011 09:56 |