/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Basic/VBA

Выпуск № 720
от 03.03.2008, 15:05

Вопрос № 124.927

Здравствуйте уважаемые эксперты! Помогите пожалуйста с еще одним вопросом: В экселевском файле на листе сформирован календарь, который представляет из себя две колонки: в одной указана дата (в ввиде дд.мм.гггг), а в другой указано рабочий это день или выходной. На этот лист с календарем ссылается программа через макрос, чтобы сравнить дату из массива данных с календарной. Скажите можно ли чтобы дата во всем календаре, а также показатели (рабочий деньвыходной день) менялась автоматически, когда наступает новый год. И как это можно реализовать с помощью макроса.

Отправлен: 26.02.2008, 15:26 Вопрос задал: Faraviper (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Megaloman Здравствуйте, Faraviper! Вот текст макроса, который выдает календарь: в колонке A формирует номер дня с начала года, в колонке B - дату, в колонке С - номер дня в неделе в колонке D - рабочий или выходной день. Здесь выходными считаются суббота и воскресенье. Это, конечно, примитив, но учесть праздники тоже можно, соответственно дописав необходимые условия. Хотя праздник типа Пасха придется добавлять все равно ручками. 'Номер года God = 2008 'Число дней в году If God Mod 4 = 0 Then NDays = 366 Else NDays = 365 End If DateFirst = DateSerial(God, 1, 1) DayOfWeek = Weekday(DateFirst, vbMonday) For i = 1 To NDays Range("A1").Offset(i - 1, 0) = i Range("B1").Offset(i - 1, 0) = DateAdd("d", i - 1, DateFirst) Range("C1").Offset(i - 1, 0) = DayOfWeek If DayOfWeek = 6 Or DayOfWeek = 7 Then Range("D1").Offset(i - 1, 0) = " Вых" Else Range("D1").Offset(i - 1, 0) = "Раб" DayOfWeek = DayOfWeek + 1 If DayOfWeek > 7 Then DayOfWeek = 1 Next --------- Нет времени на медленные танцы!

Ответ отправил: Megaloman (статус: Студент) Ответ отправлен: 26.02.2008, 18:32 Оценка за ответ: 5 Комментарий оценки: Большое спасибо! Все очень грамотно и понятно. Именно то, что мне было нужно.

Вопрос № 124.944

Создать калькулятор в VBА: 3 - TextBox - Значения для вода чисел и 1 для вывода результата! 1 - ComboBox - +,-,*,/. 1 - ComandButon - =

Отправлен: 26.02.2008, 16:34 Вопрос задал: Костишин Александр Анатолиевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Костишин Александр Анатолиевич! "Создать калькулятор в VBА" это похоже не вопрос а просьба. Евгений. Приложение: Private Sub CommandButton1_Click() Dim iVal, iT1 As Single, iT2 As Single If IsNumeric(TextBox1.Text) And IsNumeric(TextBox2.Text) Then iT1 = TextBox1.Text: iT2 = TextBox2.Text Select Case ComboBox1.ListIndex Case 0 iVal = iT1 + iT2 Case 1 iVal = iT1 - iT2 Case 2 iVal = iT1 * iT2 Case 3 If TextBox2.Text = 0 Then iVal = "на ноль делить нельзя" Else iVal = iT1 / iT2 End If End Select TextBox3.Text = iVal End If End Sub Private Sub UserForm_Activate() ComboBox1.AddItem "+": ComboBox1.AddItem "-": ComboBox1.AddItem "*": ComboBox1.AddItem "/": End Sub

Ответ отправил: Тесленко Евгений Алексеевич (статус: Студент) Ответ отправлен: 26.02.2008, 21:57

Вопрос № 124.952

Здравствуйте! Я написал программу на языке Visual Basic: Она переводит одни еденицы измерения информации в другие, а т.е. Мбиты/с в килобайты/с и т.д. Private Sub txtparamD_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call Command134_Click End If End Sub Private Sub Command134_Click() Dim paramD As Double Dim k1 As Double Dim k2 As Double Dim d14 As Double paramD = Val(txtparamD.Text) If paramD = 0 Then MsgBox "Íóëü â êà÷åñòâå çíà÷åíèÿ ñêîðîñòè íå ïðèíèìàåòñÿ!", _ vbCritical, "ErroR" Exit Sub End If If paramD < 0 Then MsgBox "Îòðèöàòåëüíîå ÷èñëî êàê çíà÷åíèå ñêîðîñòè íå ïðèíèìàåòñÿ!", _ vbCritical, "ErroR" Exit Sub End If d14 = ((paramD * 1024) * 1024) * 8 k1 = d14 / 1000 k2 = d14 / 1000000 lbl13.Caption = "кБит/с: " & Format(k1, "#0.##") lbl14.Caption = "мБит/с: " & Format(k2, "#0.##") End Sub Private Sub txtparamC_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call Command2_Click End If End Sub Private Sub Command2_Click() Dim paramC As Double Dim j1 As Double Dim j2 As Double Dim d3 As Double paramC = Val(txtparamC.Text) If paramC = 0 Then MsgBox "Íóëü â êà÷åñòâå çíà÷åíèÿ ñêîðîñòè íå ïðèíèìàåòñÿ!", _ vbCritical, "ErroR" Exit Sub End If If paramC < 0 Then MsgBox "Îòðèöàòåëüíîå ÷èñëî êàê çíà÷åíèå ñêîðîñòè íå ïðèíèìàåòñÿ!", _ vbCritical, "ErroR" Exit Sub End If d3 = paramC * 1000000 j1 = (d3 / 8) / 1024 j2 = j1 / 1024 lblX1.Caption = "Кб/с: " & Format(j1, "#0.##") lblX2.Caption = "Кб/с: " & Format(j2, "#0.##") End Sub Private Sub txtparamB_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call CmdCalculate2_Click End If End Sub Private Sub CmdCalculate2_Click() Dim paramB As Double Dim y1 As Double Dim y2 As Double Dim d1 As Double paramB = Val(txtparamB.Text) If paramB = 0 Then MsgBox "Íóëü â êà÷åñòâå çíà÷åíèÿ ñêîðîñòè íå ïðèíèìàåòñÿ!", _ vbCritical, "ErroR" Exit Sub End If If paramB < 0 Then MsgBox "Îòðèöàòåëüíîå ÷èñëî êàê çíà÷åíèå ñêîðîñòè íå ïðèíèìàåòñÿ!", _ vbCritical, "ErroR" Exit Sub End If d1 = paramB * 1024 y1 = (d1 * 8) / 1000 y2 = ((d1 * 8) / 1000) / 1000 lbl13.Caption = "кБит/с: " & Format(y1, "#0.##") lbl14.Caption = "мБит/с: " & Format(y2, "#0.##") End Sub Private Sub txtParamA_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdCalculate_Click End If End Sub Private Sub cmdCalculate_Click() Dim paramA As Double Dim x1 As Double Dim x2 As Double Dim D As Double paramA = Val(txtParamA.Text) If paramA = 0 Then MsgBox "Íóëü â êà÷åñòâå çíà÷åíèÿ ñêîðîñòè íå ïðèíèìàåòñÿ!", _ vbCritical, "ErroR" Exit Sub End If If paramA < 0 Then MsgBox "Îòðèöàòåëüíîå ÷èñëî êàê çíà÷åíèå ñêîðîñòè íå ïðèíèìàåòñÿ!", _ vbCritical, "ErroR" Exit Sub End If D = paramA * 1000 x1 = (D / 8) / 1024 x2 = (D / 8) / 1024 / 1024 lblX1.Caption = "Кб/с: " & Format(x1, "#0.##") lblX2.Caption = "Мб/с: " & Format(x2, "#0.##") End Sub Я хочу сделать так, чтобы при нажатии кнопки "очистить" у меня очищались все поля, т.е. поля, где выводится результат и поля, в которые я ввожу данные. Вопрос: скажите, пожалуйста, как мне это сделать, кнопку я могу создать, а как это действие в виде кода написать - не могу, помогите, пожалуйста ? Спасибо за помощь!

Отправлен: 26.02.2008, 17:03 Вопрос задал: Красильников И.П. (статус: 10-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 12)

Отвечает: PsySex Здравствуйте, Красильников И.П.! Можно очищать поля вручную т.е. например код для кнопки ============= Private Sub cmdClear_Click() txtparamA.Text = "" txtparamB.Text = "" txtparamC.Text = "" txtparamD.Text = "" lblX1.Caption = "" 'т.е. перечисляем все контролы которые слудует очистить 'или так, т.е. убираем тока цифры lblX2.Caption = "Мб/с: " End Sub ========== Также если на форме много контролов TextBox и все их нужно очистить, то можно использовать следующий код: =========== Dim vControl For Each vControl In Me.Controls If TypeOf vControl Is TextBox Then vControl.Text = "" End If Next =========== или обнулить контролы Label =========== Dim vControl For Each vControl In Me.Controls If TypeOf vControl Is Label Then vControl.Caption = "" 'vControl.Caption = "Мб/с: " End If Next ====== --------- Bom Shankar!

Ответ отправил: PsySex (статус: Практикант) Ответ отправлен: 26.02.2008, 18:58 Оценка за ответ: 5 Комментарий оценки: Большое спасибо!

Вопрос № 125.075

Есть два листа, на одном даны коды клиентов и сумму уплаченную ими за товары, в формате: код1 - 150 у.е. код1 - 150 у.е. код2 - 1500 у.е. код2 - 2750 у.е. код2 - 1000 у.е. код3 - 1500 у.е. код3 - 2750 у.е. код4 - 1000 у.е. тоисть клиенты делают по несколько покупок Нужно на другой лист вывести всех клиентов с суммой покупки больше 2000 Написал код, немного коряво и в нем ошибка, помогите ее найти и если не трудно написать свой более понятный вариант. Спасибо P.S. В качестве обучения очень бы хотелось увидеть вложенные Do Loop. Приложение: Range("B3").Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlYes With Worksheets("CustOrders").Range("B4") OrderSum = 0 Do While .Offset(i, 0) <> "" If .Offset(i, 0) = "" Then Exit Do Else Do While .Offset(i, 0) = .Offset(i + 1, 0) If .Offset(i, 0) = .Offset(i + 1, 0) Then OrderSum = OrderSum + .Offset(i, 1).Value i = i + 1 If OrderSum > 2000 Then Worksheets("CustOrders2").Range("A" & (4 + j)).Value = .Offset(i, 0) Worksheets("CustOrders2").Range("B" & (4 + j)).Value = OrderSum OrderSum = 0 j = j + 1 End If Else OrderSum = 0 i = i + 1 End If Loop i = i + 1 End If Loop End With

Отправлен: 27.02.2008, 10:59 Вопрос задал: Irkutskiy Konstantin (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Megaloman Здравствуйте, Irkutskiy Konstantin! Извините, не люблю искать ошибки в чужом коде, это надо проникнуться им, а это требует времени. Решение - в приложении с комментариями. Приложение: List1 = "Лист1" ' Лист со всеми покупками отсортированными по коду покупателя List2 = "Лист2" ' Лист куда помещаем суммарные покупки SumMin = 2000 ' Граничная сумма для учета AKod = "B5" ' Первая ячейка с кодом покупателя ASum = "C5" ' Первая ячейка с суммой KKod = "E" ' Столбец с кодами на листе с результатом KSum = "F" ' Столбец с суммами на листе с результатом RKod = "E2" ' Первая ячейка с кодом покупателя на листе с результатом RSum = "F2" ' Первая ячейка с итоговой суммой покупателя на листе с результатом Sheets(List2).Columns(KKod).ClearContents ' Чистим столбцы от прежних результатов Sheets(List2).Columns(KSum).ClearContents Sheets(List1).Select i = 0 j = 0 Do While Range(AKod).Offset(i, 0) <> "" TSum = 0 TKod = Range(AKod).Offset(i, 0) Do While TKod = Range(AKod).Offset(i, 0) TSum = TSum + Range(ASum).Offset(i, 0) i = i + 1 Loop If TSum >= SumMin Then Sheets(List2).Range(RKod).Offset(j, 0) = TKod Sheets(List2).Range(RSum).Offset(j, 0) = TSum j = j + 1 End If Loop Sheets(List2).Select --------- Нет времени на медленные танцы!

Ответ отправил: Megaloman (статус: Студент) Ответ отправлен: 27.02.2008, 23:28 Оценка за ответ: 4

Вопрос № 125.109

Здравствуйте! Как узнать дату последнего редактирование текущей книги? Заранее спасибо!

Отправлен: 27.02.2008, 14:01 Вопрос задала: Kulikova (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 11)

Отвечает: Megaloman Здравствуйте, Kulikova! Найти файл с этой книгой (если по умолчанию - в папке Мои документы), щелкнуть по нему правой кнопкой мыши, в появившемся меню выбрать пункт Свойства, там увидите в нижней части открывшегося окна, когда файл создан, когда изменен последний раз, когда последний раз открывался. --------- Нет времени на медленные танцы!

Ответ отправил: Megaloman (статус: Студент) Ответ отправлен: 27.02.2008, 17:21 Оценка за ответ: 2 Комментарий оценки: А что тут оценивать )). Я тож иногда ...

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Kulikova! Код в приложении. Проверяемый файл должен быть закрыт. Евгений. Приложение: Sub sDf() Dim a As Date a = FileDateTime("C:Книга1.xls") Debug.Print a End Sub

Ответ отправил: Тесленко Евгений Алексеевич (статус: Студент) Ответ отправлен: 28.02.2008, 10:52 Оценка за ответ: 4 Комментарий оценки: Спасибо, но речь идет о текущем открытом файле. Но раз нельзя так нельзя. Мы пойдем другим путем!

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.71 от 27.02.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru