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

Выпуск № 766
от 18.05.2008, 03:05

Вопрос № 135.265

Уважаемые эксперты! С прошедшими праздниками! Подскажите пожалуйста как вешить задачу в VB6. Как можно реализовать окно, состоящее из двух текстовых полей (одно над другим) с общей границей, которую можно перемещать по вертикали, соответствено изменяя размеры верхнего и нижнего поля? Или может быть есть текстбокс, позволяющий сделать два поля ввода? Заранее Спасибо.!Иван.

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

Отвечает: HookEst Здравствуйте, Сергеев Иван Иванович! делаем Splitter вручную: например ложим на форму Image Image1 он у нас будет и Splitter-ом и контейнером для TextBox-ов, т.е. TextBox-ы изменяя свои размеры не будут выходить за его границы, и суммарная высота обоих TextBox-ов будет равна высоте Image1. также конечно ложим на форму 2 TextBox-а Text1 и Text2 ну и код в приложении... константы: MIN_HEIGHT - минимальная высота TextBox-а SPLITTER_HEIGHT - высота границы между ними(за которую и двигаем) метод Realign принимает как параметр новую высоту для верхнего TextBox-а, без параметров его можно вызывать в случае если изменился размер Image1(ex в Form_Resize) Успехов. Приложение: Option Explicit Const MIN_HEIGHT = 240 Const SPLITTER_HEIGHT = 80 Private Sub Form_Load() Image1.MousePointer = 7 ' SIZE_N_S Realign (Image1.Height - SPLITTER_HEIGHT) / 2 End Sub Private Function Max(ByVal a, ByVal b) If a > b Then Max = a Else Max = b End Function Private Function Min(ByVal a, ByVal b) If a < b Then Min = a Else Min = b End Function Private Sub Realign(Optional ByVal newHeight) If IsMissing(newHeight) Then newHeight = Text1.Height End If Text1.Move Image1.Left, Image1.Top, Image1.Width, Max(Min(newHeight, Image1.Height - MIN_HEIGHT - SPLITTER_HEIGHT), MIN_HEIGHT) Text2.Move Image1.Left, Text1.Top + Text1.Height + SPLITTER_HEIGHT, Image1.Width, Max(Image1.Height - Text1.Height - SPLITTER_HEIGHT, 0) End Sub Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then Image1.Tag = "move" End Sub Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Image1.Tag = "move" Then Realign Y End If End Sub Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image1.Tag = "" End Sub

Ответ отправил: HookEst (статус: Специалист) Ответ отправлен: 05.05.2008, 12:06 Оценка за ответ: 5 Комментарий оценки: У меня просто нет слов! Здесь не только решение задачи, но для меня ещё и очень развивающий пример работы с компонентами. Ещё раз 5 баллов. СПАСИБО!!!!!!

Вопрос № 135.302

Здравствуйте, уважаемые эксперты!Помогите разобраться. У меня 2 кнопки:одна шифрует, другая расшифровывает. Код кнопки "Зашифровать": Private Sub Command4_Click() Dim d As String Dim p2 As Byte Dim p1 As Byte If fs.FileExists("текст1.txt") Then Kill "текст1.txt" a = "" If Text2.Text = "" Then MsgBox (" Операция не выполнена! " + Chr(13) + " Необходимо выбрать ключ") Else ksh = Val(Text2.Text) If fs.FileExists("текст2.txt") Then Kill "текст2.txt" idf5 = FreeFile Open "текст1.txt" For Binary As idf5 d = "" pos = 0 idf4 = FreeFile Open "текст.txt" For Binary As idf4 Get #idf4, 1, p1 Do While Not EOF(idf4) pos = pos + 1 Get #idf4, pos, p1 If p1 + ksh <= 255 Then p2 = CByte(p1 + ksh) Else p2 = CByte((p1 + ksh) Mod 256) End If d = d + Chr(p2) Loop Put #idf5, , d Close idf5 Close idf4 End If File1.Refresh Text1.Text = "" End Sub Код кнопки "Расшифровать": начало тоже самое, а главное вот это: If p1 - ksh >= 0 Then p2 = CByte(p1 - ksh) Else p2 = CByte((p1 + 256) - ksh) End If d = d + Chr(p2) - это процесс расшифровки ksh- тип integer, p1, p2 - byte. Ключ (ksh) генерируется в интервале от 0 до 1000 и выводиться в текстовое поле. Если у меня значение ключа (числовое) до 250, например 106, 192,205,217, то все замечательно шифруется и расшифровывается. А когда значение ключа больше 250, например 300,421,264,790, то у меня выходит ошибка (когда нажимаю на кнопку расшифровать) overflow. И ругается на строчку p2 = CByte((p1 + 256) - ksh). Что это может быть? Переполнение? А чего? Как правильно тогда записать?Помогите!!!!Пожалуйста!!!

Отправлен: 04.05.2008, 16:16 Вопрос задала: Cholito (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Павленко Александр Геннадьевич Здравствуйте, Cholito! >> Dim p2 As Byte В суть алгоритма не вникал, но вижу Вы задали тип Byte для переменной p2. Ее значение может быть от 0 до 255. Возможно тут и переполняется. Попробуйте тип Integer. удачи

Ответ отправил: Павленко Александр Геннадьевич (статус: 2-ой класс) Ответ отправлен: 04.05.2008, 19:56

Отвечает: Калашник Андрей Николаевич Здравствуйте, Cholito! При данном алгоритме шифрования (сдвиг по таблице ascii), ну не может быть ключ > 255. Т.к. в таблице всего 256 символов(0+255)! P.s. я Вам об этом уже писал

Ответ отправил: Калашник Андрей Николаевич (статус: 1-ый класс) Ответ отправлен: 05.05.2008, 17:12

Вопрос № 135.556

Здаствуте. Возникла проблема с выбором всей i-той строки. И её копированием в другой фаил. Заранее благодарен Приложение: For i = 8 To 1000 If Range("B" & i) <> nado Then GoTo metka1 Else c = c + 1 Windows("Проба пера.xls").Activate Range("A" & i).Select ' - ВОТ ТУТ НАДО ВЫБРАТЬ ВСЮ "i"-ТУЮ СТРОКУ, А НЕ ОДНУ ЯЧЕКУ Selection.Copy Windows("проверочны1.xls").Activate Sheets("Лист1").Select Range("A" & c).Select ' - ТО ЖЕ САМОЕ, ТОЛЬКО С "с" ActiveSheet.Paste Windows("Проба пера.xls").Activate End If metka1: Next i

Отправлен: 06.05.2008, 06:56 Вопрос задал: Иванов Антон (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Константин Павлов Здравствуйте, Иванов Антон! Для копирования строки целиком используйте Rows(i).Copy

Ответ отправил: Константин Павлов (статус: 5-ый класс) Ответ отправлен: 06.05.2008, 10:23

Отвечает: HookEst Здравствуйте, Иванов Антон! вообще-то способов много как уже сказали Rows(i) Range("A" & i).EtireRow Range(i & ":" & i) .... и еще пару замечаний чем писать: ... If Range("B" & i) <> nado Then GoTo metka1 Else ... End If metka1 ... удобнее: ... If Range("B" & i) = nado Then ... End If ... для того чтобы обращаться к окнам, книгам, листам, совсем не обязательно делать их активными (ох уж этот "записывальщик макросов") можно сразу использовать объекты и их свойства: Workbooks("Имя книги").Worksheets("Имя Листа")... для удобства можно завести переменную, и обращаться уже к ней: Dim ws as Worksheet Set ws=Workbooks("Имя книги").Worksheets("Имя Листа")... ws... И не нужно делать srcRange.Copy dstRange.Paste можно сразу писать srcRange.Copy dstRan ge это проще, быстрее и надежнее для примера, в приложении несколько вариантов, как скопировать с 8 по 1000 строки первого листа из Проба пера.xls со значением во втором столбце равным nado, на первый лист из проверочны1.xls попытался использовать все, что говорил подразумевалось, что книга Проба пера - активная c - не знаю чему равно изначально, я принял 6 Успехов. Приложение: Option Explicit Sub Макрос1() Dim r As Range Dim c As Long c = 6 For Each r In Rows("8:1000") If r.Cells(2) = nado Then r.Copy Workbooks("проверочны1.xls").Worksheets("Лист1").Rows(c): c = c + 1 Next r End Sub Sub Макрос2() Dim i As Long Dim src As Worksheet Dim dst As Range Set src = Workbooks("Проба пера.xls").Worksheets(1) Set dst = Workbooks("проверочны1.xls").Worksheets("Лист1").Rows(6) For i = 8 To 1000 If src.Cells(i, 2) = nado Then src.Range(i & ":" & i).Copy dst: Set dst = dst.Offset(1) Next i End Sub Sub Макрос3() With Rows("7:1000") '7 т.к. 1 строка - заголовок Автофильтра .AutoFilter Field:=2, Criteria1:=nado .Offset(1).SpecialCells(xlCellTypeVisible).Copy Workbooks("проверочны1.xls").Worksheets("Лист1").Cells(6, 1) .AutoFilter End With End Sub

Ответ отправил: HookEst (статус: Специалист) Ответ отправлен: 08.05.2008, 11:40

Вопрос № 135.591

Добрый день, уважаемый эксперт! Помогите пожалуйста, решить следующую задачу на VBA в Excel. Дано: массив на листе "Выводы" (в нем столбцы с 5-го по 7-ой заполнены числовыми значениями). Нужно подсчитать сумму по каждому из этих столбцов и записать ее в ячейку под каждым из столбцов. Задача осложняется тем, что размер массива по количеству строк может меняться. Число столбцов постоянно и равно 15. Спасибо.

Отправлен: 06.05.2008, 12:18 Вопрос задал: Савкин Иван Владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Константин Павлов Здравствуйте, Савкин Иван Владимирович! Для решения Вашей задачи необходимо вначале определить последнюю непустую ячейку в строке. Для этого используем конструкцию Columns(5).End(xlDown).Row, где 5 - номер столбца, в котором определяем последнюю строку. Полученное значение присвоим переменной irow: irow = Columns(i).End(xlDown).Row. Далее, зная первую и последнюю ячейку, определим сумму по столбцу, используя стандартную функцию WorksheetFunction.Sum(Range(Cells(1, 5), Cells(irow, 5))). Терерь остается ее записать в ячейку, следующую за последней заполненной: Worksheets("Выводы").Cells(irow + 1, 5).Value = WorksheetFunction.Sum(Range(Cells(1, 5), Cells(irow, 5))) Для удобства обработки нескольких столбцов введем циклическую обработку. Пример в приложении. Приложение: Sub summa() For i = 5 To 7 irow = Columns(i).End(xlDown).Row Worksheets("Выводы").Cells(irow + 1, i).Value = WorksheetFunction.Sum(Range(Cells(1, i), Cells(irow, i))) Next i End Sub

Ответ отправил: Константин Павлов (статус: 5-ый класс) Ответ отправлен: 06.05.2008, 14:53

Вопрос № 135.656

Уважаемые эксперты, не могу понять, в чём ошибка в коде! Задание такое: составить программу значения вычисления функции f(x) на отрезке [a,b] в точках xi=a+ih, где h=(b-a)/m, m-заданное целое число. Выполняю в Microsoft Office Excel 2003. Подскажите в чём ошибка??? Приложение: Public Sub Задача_3() Dim a, b, h, x, f, z As Single, m As Integer, s As String a = InputBox("Введите начало отрезка a", "Задача 3") b = InputBox("Введите конец отрезка b", "Задача 3") m = InputBox("Введите число точек m", "Задача 3") h = (b - a) / m z = Application.Pi() Worksheets(4).Cells(1, 1).Value = "x" Worksheets(4).Cells(1, 2).Value = "f" i = 2 For x = a To b Step h f = 1 / Atn(x * z / 180) x = Format(x, "0") f = Format(f, "000.000") Worksheets(4).Cells(i, 1).Value = x Worksheets(4).Cells(i, 2).Value = f i = i + 1 Next x Worksheets(4).Cells(i, 1).Value = "Программу выполнил XXX" s = Now Worksheets(4).Cells(i + 1, 1).Value = s End Sub

Отправлен: 06.05.2008, 18:50 Вопрос задал: Кондрашов Дмитрий (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: megaloman Здравствуйте, Кондрашов Дмитрий! Я предпочел переписать цикл, так как многократное суммирование чисел ведет к накоплению вычислительной ошибки. И, кроме того, в цикле Вы переопределяете переменную цикла - это тоже ошибка. f = 1 / Atn(x * z / 180) Выражение ошибочно, так как (по определению)- арктангенс вычисляет УГОЛ тангенс которого =АРГУМЕНТУ Т. е. артангенс вычисляется не от угла, а от значения, результат -радианы И, далее, чтобы замешивать далее результат арктангенса в вычислениях, как-то преобразовывать результат функции не надо. Будьте осторожнее, позаботьтесь чтобы аргумент арктангенса не был равен 0, иначе деление на 0 - это ошибка Как Вы написали в коде Worksheets(4), у Вас обязательно в книге должно быть не менее 4 листов. И, наконец, в приложении Ваш измененный текст программульки Приложение: Public Sub Задача_3() Dim a, b, h, x, f, z As Single, m As Integer, s As String a = InputBox("Введите начало отрезка a", "Задача 3") b = InputBox("Введите конец отрезка b", "Задача 3") m = InputBox("Введите число точек m", "Задача 3") h = (b - a) / m z = Application.Pi() Worksheets(4).Cells(1, 1).Value = "x" Worksheets(4).Cells(1, 2).Value = "f" For i = 0 To m x = a + i * h f = 1 / Atn(x) ' Worksheets(4).Cells(i + 2, 1).Value = x ' Worksheets(4).Cells(i + 2, 2).Value = f Worksheets(4).Cells(i + 2, 1).Value = Format(x, "000.000") Worksheets(4).Cells(i + 2, 2).Value = Format(f, "000.000") Next i Worksheets(4).Cells(m + 3, 1).Value = "Программу выполнил XXX" s = Now Worksheets(4).Cells(m + 4, 1).Value = s End Sub --------- Нет времени на медленные танцы

Ответ отправил: megaloman (статус: Практикант) Ответ отправлен: 06.05.2008, 21:44 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо за подробнейший и своевременный ответ!!!

Вопрос № 135.710

Уважаемые эксперты! Где можно получить информацию о свойствах и методах компонента Shockwave Flash.ocx в VB6 (хорошо бы с примерами). Заранее благодарен.

Отправлен: 06.05.2008, 23:54 Вопрос задал: Кузнецов Б. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Кузнецов Б.! Получить информацию о свойствах и методах компонента Shockwave Flash.ocx, так же и других, можно в Object Browser редактора VB6 или VBA, предварительно подключив библиотеку "Shockwave Flash.ocx" к проекту. Если библиотека установлена в Вашей системе полностью и будет доступна справка, в ней и можно посмотреть "примеры использования". Иначе только в справочниках или на сайте производителя. Евгений.

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

Вопрос № 135.912

Помогите решить на VB задачку с использованием массива данных. Я в VB полный ноль. Заранее благодарен! Ассоциация художников провела выставку-продажу картин. В течение недели ежедневно выставлялось 24 картины. О каждом дне выставки известны названия картин и авторы. Только проданные в течение дня картины заменялись новыми. Получить перечень проданных картин.

Отправлен: 08.05.2008, 11:39 Вопрос задал: Щербинин Павел Алексеевич (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Бахтин Владимир Александрович Здравствуйте, Щербинин Павел Алексеевич! Может поможет: Ссылка Ссылка А вообще своей самому решать надо! И зачем Вам решать задачу, если Вы, как сказали, "В VB полный ноль"? Длинная ссылка ----- ∙ Отредактировал: Цикалов Игорь Константинович (Профессионал) ∙ Дата редактирования: 08.05.2008, 20:31

Ответ отправил: Бахтин Владимир Александрович (статус: 3-ий класс) Ответ отправлен: 08.05.2008, 20:24 Оценка за ответ: 2 Комментарий оценки: Погуглить я и сам мог.

Вопрос № 135.930

Уважаемые эксперты очень нужна ваша помощь! Необходимо решить задачу на VB с использованием ms access. Заранее благодарен! Структура таблиц: Таблица UCH (ученики) Фамилия|Пол|Класс|Средняя оценка|Физическое развитие Таблица SM (семья) Фамилия ученика|Фамилия одного из Родителей|Должность|Заработная плата|Количество детей|Семейный бюджет В таблице SM (семья) указывается фамилия, имя и отчество одного из родителей. В таблице UCH указываются сведения о всех учениках школы. Составить меню: 1. Распечатка исходных таблиц. 2. Формирование и выдача справок : Справка 1. Список учеников 10-11 классов со слабым физическим развитием. Список упорядочить по классам и алфавиту. Справка 2. Список учеников и родителей многодетных семей (3 и более детей). Справка 3. Список учеников 9-х классов из многодетных семей (3 и более детей), имеющих средний балл, больший 4,2. Список упорядочить по убыванию количества детей и баллов. 3. Создание документа (отчета): Сведения об учениках 10-х классов, живущих в семьях с душевым доходом, меньшим 2000 руб. Фамилия|Пол|Класс|Средний балл|Физическое развитие|Душевой доход

Отправлен: 08.05.2008, 12:05 Вопрос задал: Щербинин Павел Алексеевич (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Бахтин Владимир Александрович Здравствуйте, Щербинин Павел Алексеевич! Посмотрите примеры на этих сайтах: http://www.planetsourcecode.com/vb/default.asp?lngWId=1 http://www.vbnet.ru/ http://vbstreets.ru/ http://www.sources.ru/index.html За вас никто решать не будет. Удачи!

Ответ отправил: Бахтин Владимир Александрович (статус: 3-ий класс) Ответ отправлен: 08.05.2008, 20:32

Вопрос № 136.133

hi deaar experts!!! разрулите ситуацию-(код в приложении) - функцией findfirst/find next исчю по фамилии в колонке фио в таблице и вывожу место работы этих людей в списке. если находит одно/два совпадение - то все как бы ок. но когда их три и более -то начинаетлезть не другие строки таблицы, не все выводит и т.д. вопрос в чем дело и как ето устранить заранее благодарен Приложение: Private Sub Êíîïêà64_Click() Dim str As String Dim db As Database Dim rs As Recordset Set db = CurrentDb Set rs = db.OpenRecordset("Ëè÷íûåÄàííûå", dbOpenSnapshot) str = "ÔÈÎ like '" & Forms!Àïð!Ïîëå0 & "*" & "'" rs.FindFirst str If rs.NoMatch Then MsgBox "íåò " Exit Sub Else Ñïèñîê75.AddItem rs!ÌåñòîÐàáîòû Do Until rs.EOF rs.FindNext str If rs.NoMatch = False Then Ñïèñîê75.AddItem rs!ÌåñòîÐàáîòû End If rs.MoveNext Loop End If rs.Close db.Close End Sub

Отправлен: 09.05.2008, 23:46 Вопрос задал: S@ZaN (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: HookEst Здравствуйте, S@ZaN! MoveNext зачем? ... rs.FindFirst str If rs.NoMatch Then MsgBox "not found!" Else Do Until rs.NoMatch Ñïèñîê75.AddItem rs!ÌåñòîÐàáîòû rs.FindNext str Loop End If rs.Close Set rs = Nothing

Ответ отправил: HookEst (статус: Специалист) Ответ отправлен: 12.05.2008, 10:57

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