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

Выпуск № 765
от 07.05.2008, 04:05

Вопрос № 133.928

В программе на VB6 имеется окно RichTextBox. Как в него загрузить текст из HTML-документа (например книгу с www.lib.ru) Вполне устроит вариант, что загруженный текст будет без сохранения первоначального оформления (шрифт, цвет, картинки и т.п.) - чисто текстовая информация.

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

Отвечает: Павленко Александр Геннадьевич Здравствуйте, Perkussi! Предлагаю побайтно считывать из htm файла инфу и если символ = "<" то не добавлять его и все последующие символы в текстбокс пока не считается ">". В принципе все просто.

Ответ отправил: Павленко Александр Геннадьевич (статус: 2-ой класс) Ответ отправлен: 24.04.2008, 15:38 Оценка за ответ: 3 Комментарий оценки: решение самое простое, которое я уже пробовал. Если побайтно добавлять текст=текст+новый символ, то при размере файла более мегабайта это занимает ОЧЕНЬ много времени Может есть другой метод побайтного чтения в переменную?

Отвечает: PsySex Здравствуйте, Perkussi! Короч делаем так :-) На форму помещаем WebBrowser(Microsoft Internet Controls) и кнопку. Код для кнопки в приложении. Приложение: Private Declare Sub Sleep Lib "kernel32" (ByVal lMilliseconds As Long) Private Sub Command1_Click() WebBrowser1.Navigate "c:a.htm" Sleep (300) DoEvents WebBrowser1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER WebBrowser1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER Open "c:111.txt" For Output As 1 Print #1, Clipboard.GetText Close #1 End Sub --------- Bom Shankar!

Ответ отправил: PsySex (статус: Практикант) Ответ отправлен: 24.04.2008, 16:54 Оценка за ответ: 5 Комментарий оценки: Очень хорошая подсказка! Правда, строчка WebBrowser1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER даёт ошибку"Run-time error \'-2147221248, (80040100)\': Method \'ExecWB\' of object \'IWebBrowser2\' failed". Поэтому "пятерка" так сказать - авансом Помогите разобраться, чего не хватает.

Вопрос № 133.948

Здравствуйте, уважаемые эксперты!!! Спасибо что откликнулись и помогли мне. Теперь я умею открывать и сохранять изменения в файл. Помогите мне пожалуйста с шифрованием по модулю 2. Есть примерный код, только он почему-то не работает, все время только выходит msgbox, а дальше не шифрует. ksh-это я как поняла ключ. на форме должно быть 2 textbox: в одном ключ написан,в другом выводиться сначала исходный текст из файла текст.txt (по "клику" на filelistdox), а потом зашифрованный текст и при этом сохраняется в файле текст1.txt, который также отображается в filelistbox. Я запуталась с этим кодом..я вижу он как-то не доконца доработан...а как правильно не сооброжу..Посмотрите пожалуйста! Приложение: шифрование двоичного файла Dim d As String Dim p2 As Byte Dim p1 As Byte If fs.FileExists("текст1.txt") Then Kill "текст1.txt" a = "" If ksh = -1 Then MsgBox ("Операция не выполнена. " + Chr(13) + " Необходимо выбрать ключ ") Else Text2.Text = ksh If fs.FileExists("текст2.txt") Then Kill "текст2.txt" idf5 = FreeFile Open "текст1.txt" For Binary As idf5 d = "" ‘ записывается зашифрованный текст pos = 1 idf4 = FreeFile Open "текст.txt" For Binary As idf4 Get #idf4, 1, p1 ‘ из исходного файла читается первый бит Do While Not EOF(idf4) pos = pos + 1 If p1 + ksh <= 255 Then ‘ нет переполнения p2 = CByte(p1 + ksh) ‘ сложение информации, представленной в двоичном виде Else p2 = CByte((p1 + ksh) Mod 256) End If d = d + Chr(p2) ‘ формирование строки зашифрованного текста Get #idf4, pos, p1 ‘ чтение следующего байта Loop Put #idf5, , d ‘ запись зашифрованного текста в файл Close idf5 Close idf4

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

Отвечает: Калашник Андрей Николаевич Здравствуйте, Cholito!  шифрование двоичного файла Dim d As String Dim p2 As Byte Dim p1 As Byte If fs.FileExists("текст1.txt") Then Kill "текст1.txt" a = "" If ksh = -1 Then  MsgBox ("Операция не выполнена. " + Chr(13) + " Необходимо выбрать ключ ")   Else  Text2.Text = ksh 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

Ответ отправил: Калашник Андрей Николаевич (статус: 1-ый класс) Ответ отправлен: 25.04.2008, 11:54 Оценка за ответ: 5 Комментарий оценки: Спасибо!!!!Шифрует!!!!!!!!Только я этот ksh=-1 убрала, так проще.

Вопрос № 134.109

уважаемые эксперты, подскажите как из открытого эксель файла открыть другой, прочитать из него все строки в массив, закрыть его. а потом уже в исходном файле работать с означенным массивом? Приложение: Sub dobavlenie() my_file = "" With Application.FileDialog(msoFileDialogOpen) .InitialFileName = Cells(2, 2).Value .Show my_file = .SelectedItems(1) End With Workbooks.Open my_file nmy_file = ActiveWorkbook.Name Windows(nmy_file).Activate Workbooks(nmy_file).Activate Workbooks(nmy_file).Sheets.Select Dim tek_sht(700) As sht i = 2 Do While Cells(i, 1).Value <> "" tek_sht(i - 1).s_f = Cells(i, 1).Value tek_sht(i - 1).s_m = Cells(i, 2).Value tek_sht(i - 1).s_o = Cells(i, 3).Value i = i + 1 Loop tek_kvo_sotr = i MsgBox "Всего на странице прочитано: " + Str(i - 1) + " строк" Workbooks(nmy_file).Close SaveChanges:=False MsgBox "Закрыли добавляемое" End Sub

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

Отвечает: HookEst Здравствуйте, Сикорский Сергей Георгиевич! проверяйте значение возвращаемое Show если файл открывается только для чтения, безопаснее использовать не Open, а Add(откроется только копия файла) чтобы работать с книгами, листами диапазонами, совсем не обязательно их select? activate ... для получения массива значений используйте value Успехов Приложение: Option Explicit Sub dobavlenie() Dim wb As Workbook Dim values On Error GoTo dobavlenie_Error With Application.FileDialog(msoFileDialogOpen) .InitialFileName = Cells(2, 2).Value If .Show = -1 Then Set wb = Workbooks.Add(.SelectedItems(1)) values = wb.Worksheets(1).UsedRange.Columns("A:C").Value 'values - двумерный массив значений ячеек, первых 3-х столбцов wb.Close False End If End With MsgBox "Всего на странице прочитано: " & (UBound(values) - LBound(values) + 1) & "строк" dobavlenie_Exit: Exit Sub dobavlenie_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure dobavlenie of Module Module1" Resume dobavlenie_Exit End Sub

Ответ отправил: HookEst (статус: Специалист) Ответ отправлен: 25.04.2008, 14:20 Оценка за ответ: 5 Комментарий оценки: а как потом работать с массивом values? что такое: UBound и LBound

Вопрос № 134.121

Уважаемые эксперты, есть столбец в который вписаны адреса. Необходимо чтобы проверялось условие что если в строчке, в адресе содержится "Московская область", то в соседний столбец ставилась например цифра 1 иначе 0. Заранее благодарю за помощь.

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

Отвечает: megaloman Здравствуйте, Meridian2045! Если в А1 текст, то формула в , допустим, В1 вернет ИСТИНА ИЛИ ЛОЖЬ =ЕЧИСЛО(ПОИСК("Московская область";A1)) вернет ИСТИНА или ЛОЖЬ в зависимомти, есть ли Московская область в A1 или нет формула =ЕСЛИ(ЕЧИСЛО(ПОИСК("Московская область";A1));1;0) вернет 1 или 0 в зависимомти, есть ли Московская область в A1 или нет --------- Нет времени на медленные танцы

Ответ отправил: megaloman (статус: Студент) Ответ отправлен: 25.04.2008, 15:49 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо, всё работает.

Отвечает: Калашник Андрей Николаевич Здравствуйте, Meridian2045! dim i as long for i=1 to 10000 range("A" & cstr(i)).select if activecell.value="" then exit for dim j as long for j=1 to len(activecell.value) if ucase$(mid$(activecell.value,j,len("Московская область")))="МОСКОВСКАЯ ОБЛАСТЬ" THEN range("B" & cstr(i)).select activecell.value="1" end if next next

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

Вопрос № 134.163

Здравствуйте, подскажите ,пожалуйста, как исправить данную ошибку "Объект <имя> не найден ядром базы данных Microsoft Jet. Проверьте существование объекта и правильность имени и пути. (Ошибка 3011) " Пересвязывать каждую таблицу в каждой базе мне не подходит, уж слишком много их, знаете ли более быстрый способ?

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

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Tatianovna! Перелинковывать (пересвязывать) таблицы БД не будет необходимости если у источника данных не будет изменяться имя и расположение (путь). Microsoft Jet подключается к внешним таблицам MS Access с сохранением абсолютного пути. Если используются данные из таблиц другого поставщика (не MS Access), решение сводится к созданию файлового DSN в источниках данных (ODBC). В котором и будет хратиться "строка подключения". Конечно самым простым способом в случае изменения пути расположения БД является программная перелинковка, жаль, что Вам это не подходит. Евгений.

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

Вопрос № 134.442

Доброго времени суток, Уважаемые эксперты! Надеюсь на Вашу помощь! Имеется программа перевода целых и дробных чисел из одной с/с в другую. Программа отлично переводит числа в пределах от 2 до 10 с/с, но отказывается работать с буквами, т.е., например, при переводе числа "F" из 16 с/с в другие выдаёт ошибку, хотя обратно переводит хорошо. Подскажите, пожалуйста, начинающему! Приложение: Dim priznak As Byte Dim spisok As String Private Sub Command1_Click() Call osnova End Sub Sub osnova() spisok = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.," 'основные вычисления If Text1.Text = " " Then Exit Sub Label1 = "Думаю..." Text3.Text = " " znak = " " chislo1 = Text1.Text chislo2 = " " If Mid(chislo1, 1, 1) = "-" Then chislo1 = Mid(chislo1, 2): znak = "-" Call proverka_simvolov(chislo1, spisok) 'проверка допустимых символов If priznak = 1 Then Label1 = "Недопустимый символ в числе!": Exit Sub 'проверка двойных точек: If InStr(InStr(chislo1, ".") + 1, chislo1, ".") <> 0 Then Label1 = "Более одной десятичной точки в числе!": Exit Sub If InStr(InStr(chislo1, ",") + 1, chislo1, ",") <> 0 Then Label1 = "Более одной десятичной точки в числе!": Exit Sub 'если и точка и запятая: If InStr(chislo1, ".") <> 0 And InStr(chislo1, ",") <> 0 Then Label1 = "Вы уж определитесь - чем Вы обозначаете точку - точкой или запятой": Exit Sub 'разделение числа на целую (chislo_1) и дробную (chislo_2) части: popolam = InStr(chislo1, ".") + InStr(chislo1, ",") Select Case popolam Case 0 chislo_1 = chislo1 chislo_2 = "0" Case 1 chislo_1 = "0" chislo_2 = Mid(chislo1, 2) Case Is > 1 chislo_1 = Left(chislo1, popolam - 1) chislo_2 = Mid(chislo1, popolam + 1) End Select sys1 = Val(Combo1.Text) sys2 = Val(Combo2.Text) Call proverka_cifr(chislo_1, sys1) If priznak = 1 Then Label1 = "При данной системе числа в этом числе не может быть таких цифр!": Exit Sub Call proverka_cifr(chislo_2, sys1) If priznak = 1 Then Label1 = "При данной системе числа в этом числе не может быть таких цифр!": Exit Sub 'основной блок вычислений On Error GoTo errorlabel 'перевод из любой системы в десятичную целой части числа chis1 = 0 For x = 1 To Len(chislo_1) chis1 = chis1 + CDec((InStr(spisok, Mid(chislo_1, CInt(x), 1)) - 1) * (sys1 ^ (Len(chislo_1) - x))) Next 'перевод из любой системы в десятичную дробной части числа chis2 = 0 For x = 1 To Len(chislo_2) chis2 = chis2 + CDec((InStr(spisok, Mid(chislo_2, CInt(x), 1)) - 1) * (sys1 ^ (-x))) Next 'перевод из десятичной системы в любую целой части числа Dim ostatok As Variant chislo_1 = " " Do ostatok = chis1 - Int(chis1 / CDec(sys2)) * CDec(sys2) chis1 = Int(chis1 / CDec(sys2)) chislo_1 = Mid(spisok, CInt(ostatok) + 1, 1) + chislo_1 Loop While chis1 - sys2 >= 0 If chis1 <> 0 Then chislo_1 = Mid(spisok, CInt(chis1) + 1, 1) + chislo_1 'перевод из десятичной в любую дробной части числа Dim celoe As Double chislo_2 = "" For x = 0 To Val(Combo3.Text) - 1 celoe = Int(chis2 * sys2) chis2 = chis2 * CDec(sys2) - Int(chis2 * CDec(sys2)) chislo_2 = chislo_2 + Mid(spisok, CInt(celoe) + 1, 1) Next x If chislo_2 = "0" Then chislo_2 = "" chislo2 = znak & chislo_1 & "." & chislo_2 Text3.Text = chislo2 Label1 = "Готово!" If sys1 = sys2 Then Label1 = "Можно было и так догадаться! :)" Exit Sub errorlabel: Label1 = "Переполнение: число слишком большое!" End Sub Sub proverka_cifr(ByVal a As String, ByVal sys1 As Double) priznak = 0 Dim x As Integer For x = 1 To Len(a) If InStr(spisok, Mid(a, x, 1)) - 1 >= sys1 Then priznak = 1: Exit For Next x End Sub Sub proverka_simvolov(ByVal a As String, ByVal spisok As String) priznak = 0 Dim x As Integer For x = 1 To Len(a) If CInt(InStr(spisok, Mid(a, x, 1))) = 0 Then priznak = 1: Exit For Next x End Sub

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

Отвечает: Черников Игорь Владимирович Здравствуйте, Lordaleksej! Я Вам уже исправлял Ваш код, но Вы почему-то опять вернули все ошибки на прежнее место. Что ж, исправлю ещё раз. Удачи! Приложение: Dim priznak As Byte Dim spisok As String Private Sub Form_Load() spisok = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" 'При данном наборе символов система исчисления не может быть >36!!! For i = 2 To Len(spisok) 'Заполяем комбо Combo1.AddItem i Combo2.AddItem i Next i End Sub Private Sub Command1_Click() 'основные вычисления If Trim(Text1.Text) = "" Then Exit Sub 'пожалуйста, не ставьте между кавычками пробел! Label1 = "Думаю..." Text3.Text = "" znak = "" chislo1 = Format(Text1.Text, ">") chislo2 = "" If Mid(chislo1, 1, 1) = "-" Then chislo1 = Mid(chislo1, 2): znak = "-" Call proverka_simvolov(chislo1, spisok) 'проверка допустимых символов If priznak = 1 Then Label1 = "Недопустимый символ в числе!": Exit Sub 'проверка двойных точек: If InStr(InStr(chislo1, ".") + 1, chislo1, ".") <> 0 Then Label1 = "Более одной десятичной точки в числе!": Exit Sub If InStr(InStr(chislo1, ",") + 1, chislo1, ",") <> 0 Then Label1 = "Более одной десятичной точки в числе!": Exit Sub 'если и точка и запятая: If InStr(chislo1, ".") <> 0 And InStr(chislo1, ",") <> 0 Then Label1 = "Вы уж определитесь - чем Вы обозначаете точку - точкой или запятой": Exit Sub 'разделение числа на целую (chislo_1) и дробную (chislo_2) части: popolam = InStr(chislo1, ".") + InStr(chislo1, ",") Select Case popolam Case 0 chislo_1 = chislo1 chislo_2 = "0" Case 1 chislo_1 = "0" chislo_2 = Mid(chislo1, 2) Case Is > 1 chislo_1 = Left(chislo1, popolam - 1) chislo_2 = Mid(chislo1, popolam + 1) End Select sys1 = Val(Combo1.Text) sys2 = Val(Combo2.Text) Call proverka_cifr(chislo_1, sys1) If priznak = 1 Then Label1 = "При данной системе числа в этом числе не может быть таких цифр!": Exit Sub Call proverka_cifr(chislo_2, sys1) If priznak = 1 Then Label1 = "При данной системе числа в этом числе не может быть таких цифр!": Exit Sub 'основной блок вычислений On Error GoTo errorlabel 'перевод из любой системы в десятичную целой части числа chis1 = 0 For x = 1 To Len(chislo_1) chis1 = chis1 + CDec((InStr(spisok, Mid(chislo_1, CInt(x), 1)) - 1) * (sys1 ^ (Len(chislo_1) - x))) Next 'перевод из любой системы в десятичную дробной части числа chis2 = 0 For x = 1 To Len(chislo_2) chis2 = chis2 + CDec((InStr(spisok, Mid(chislo_2, CInt(x), 1)) - 1) * (sys1 ^ (-x))) Next 'перевод из десятичной системы в любую целой части числа Dim ostatok As Variant chislo_1 = "" Do ostatok = chis1 - Int(chis1 / CDec(sys2)) * CDec(sys2) chis1 = Int(chis1 / CDec(sys2)) chislo_1 = Mid(spisok, CInt(ostatok) + 1, 1) + chislo_1 Loop While chis1 - sys2 >= 0 If chis1 <> 0 Then chislo_1 = Mid(spisok, CInt(chis1) + 1, 1) + chislo_1 'перевод из десятичной в любую дробной части числа Dim celoe As Double chislo_2 = "" For x = 0 To Val(Combo2.Text) - 1 celoe = Int(chis2 * sys2) chis2 = chis2 * CDec(sys2) - Int(chis2 * CDec(sys2)) chislo_2 = chislo_2 + Mid(spisok, CInt(celoe) + 1, 1) Next x If Val(chislo_2) = 0 Then chislo_2 = "" If Val(chislo_2) > 0 Then chislo2 = znak & chislo_1 & "." & chislo_2 Else chislo2 = znak & chislo_1 End If Text3.Text = chislo2 Label1 = "Готово!" If sys1 = sys2 Then Label1 = "Можно было и так догадаться!" Exit Sub errorlabel: Label1 = "Переполнение: число слишком большое!" End Sub Sub proverka_cifr(ByVal a As String, ByVal sys1 As Double) priznak = 0 Dim x As Integer For x = 1 To Len(a) If InStr(spisok, Mid(a, x, 1)) - 1 >= sys1 Then priznak = 1: Exit For Next x End Sub Sub proverka_simvolov(ByVal a As String, ByVal spisok As String) priznak = 0 Dim x As Integer For x = 1 To Len(a) If CInt(InStr(spisok, Mid(a, x, 1))) = 0 Then priznak = 1: Exit For Next x End Sub --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: Студент) Ответ отправлен: 28.04.2008, 16:19 Оценка за ответ: 5

Вопрос № 134.464

Здраствуйте. Я только начал использовать VB. У меня возникла проблемма с вводом и выводом букв узбекской кирилицы (қ-1179.ғ-1203. ҳ-1171) тут они вот тоже квадратами а в VB в textbox заменяются вопросами, а также этому вопросу соответственно присваивается код 63. Вообщем я сам не могу справится с данной задачей. Вроде стандартные шрифты XP данные символы понимают в других приложениях, а VB не хотят.

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

Отвечает: Черников Игорь Владимирович Здравствуйте, Dim1ka! Возможно у Вас не установлены шрифты Узбекского языка, вот по этой ссылке скачайте шрифт cournuz, распакуйте и установите в систему http://rusfaq.ru/upload/567 А так же добавьте узбекскую раскладку клавиатуры, если ещё не добавили. При наборе текста выбирайте этот шрифт. В VB тоже укажите этот шрифт. Ссылка на источник: http://saviturnet.atspace.com/ (Ссылка почему-то работает со второго-третьего раза. Пробуйте и всё получится!) Удачи! --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: Студент) Ответ отправлен: 28.04.2008, 17:13 Оценка за ответ: 4 Комментарий оценки: Я бы не хотел добавлять какие либо шрифты, узбекский язык WindowsXP понимает он установлен так же как и раскладка, просто добавление таких шрифтов означает что мне при установке программ так же надо будет устанавливать и данный шрифт.

Вопрос № 134.606

Всем привет! меня попросили сделать лабу на Бейсике(из под Dos), все получается, знаний хватает из Паскаля, а не могу описать и выполнить свою собственную функцию. Мне бы полный примерчик! Приложение: Код примерного вида, основанный на какой-то методичке препода: Start: 10 function al (a as double)double a=a+10 end function 20 b=al(30) 30 print "b=";b end типа вывестись на экран должно b=40, но может, я описание функции не туда вставляю?! подскажите!!!

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

Отвечает: Павленко Александр Геннадьевич Здравствуйте, Чеботок Алексей Андреевич! Компилятор вроде подсказывает в этом случае, что где не так ;) Приложение: DECLARE FUNCTION al! (a AS DOUBLE) ' заметьте, тип функции задается суффиком, хотя можно и не задавать ничего - будет стандартный интегер =) b = al(30) PRINT "b="; b END FUNCTION al (a AS DOUBLE) al = a + 10 END FUNCTION

Ответ отправил: Павленко Александр Геннадьевич (статус: 2-ой класс) Ответ отправлен: 29.04.2008, 07:53 Оценка за ответ: 5 Комментарий оценки: Спасибо, большое!

Вопрос № 134.683

Здраствуйте!...Вот тут такакя скорей геометрическа задачка...Мне нужно вычислить объем тетраэдра боковое ребро которого a=23,4 см

Отправлен: 29.04.2008, 15:01 Вопрос задал: Китаев Кирилл Артурович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Мелиш Александр Здравствуйте, Китаев Кирилл Артурович! по адресу в приложении Вы сможете посмотеть теоретическую информацию по Вашей теме, а именно в самом конце страницы говорится: Объём правильного тетраэдра: V=(a^3*√2)/12, где а-длина ребра. Приложение: http://www.fos.ru/matemat/9144.html http://www.college.ru/mathematics/courses/stereometry/content/chapter8/section/paragraph5/theory.html

Ответ отправил: Мелиш Александр (статус: 1-ый класс) Ответ отправлен: 04.05.2008, 09:34 Оценка за ответ: 5

Вопрос № 134.730

Здравствуйте, Уважаемые эксперты! Как в Word'е можно создать программу, разделяющая файлы на несколько частей. Например, ест файл, который совершит 4 страницы. Их надо сохранить на 4 файлы. И еще, ест ли функция или макрос в Excel’е, который сортирует список по второй букве. Спасибо

Отправлен: 29.04.2008, 19:11 Вопрос задал: Muhammedov Abdurohman (статус: 4-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: megaloman Здравствуйте, Muhammedov Abdurohman! Ответ на второй вопрос Если под списком подразумевается текстовая информация в столбце, допустим, начиная с ячейки A5, которую надо отсортировать по второй букве и далее, не принимая во внимание первую букву, то, например, в ячейке B5 напишем формулу: =ПСТР(A5;2;254) Эта формула вырежет из строки в ячейке A5 подстроку, начиная со 2 позиции и до конца строки (тут я предположил, что Ваши строки короче, чем 254 символа. Размножим эту формулу в столбце B до конца строк, которые надо сортировать (допустим, до 100 строки). Далее, помечаем строки от 5 до 100. Сверху в меню Данные - Сортировка - Сортировать по (Выбираем столбец B) - По возрастанию (или убыванию как Вам угодно) - идентифицировать поля по обозначениям столбцов листа -OK Получите отсортированный список. Далее столбец B можно или удалить, или скрыть. --------- Нет времени на медленные танцы

Ответ отправил: megaloman (статус: Студент) Ответ отправлен: 29.04.2008, 19:58 Оценка за ответ: 4 Комментарий оценки: Да. Правильно. Спасибо за ответ. Но я хотел, чтобы и 1 буквы списка остались и эту сортировку делам сам макрос

Вопрос № 134.806

Здравствуйте, уважаемые эксперты. C наступающими праздниками! Кто-то отдыхает, а кто-то интенсивно трудится. Немогу решить две задачки по обработки символьных переменных: 1)текст задан следующим образом: первый символ - цифра, указывающая длинну первого слова, за первым словом - вновь цифра, указывающая длинну второго слова (длинна каждого слова<=9) и т.д. Вместо цифр, указывающих длинну слова, вставить числа, указывающие координаты следующего слова. 2)Вторую задачу я решил на Pascal, но на Basic она не работает, возможно я ошибся при "переводе", посмотрите пожалуйста. На Pascal: {Назовем сложностью предложения сумму количества слов и знаков препинания. Определить сложность заданного предложения.} program u2; var a:string;{строка до 256 знаков} n,i,s:integer; begin writeln('vvedite tekst: '); readln(a); {ввод строки} for i:=1 to length(a) do {для i=1 до длинны(а)} if (ord(a[i]) < 48) OR ((ord(a[i]) > 57) AND (ord(a[i]) < 65)) OR ((ord(a[i]) > 90) AND (ord(a[i]) < 97)) OR ((ord(a[i]) > 122) AND (ord(a[i]) < 128)) OR ((ord(a[i]) > 175) AND (ord(a[i]) < 224)) OR (ord(a[i]) > 239) THEN s := s + 1; {если символ не буква и не цифра то сложность=сложность+1} s=s+1; {Пробелов между словами на один меньше чем слов поэтому сложность=сложность+1} writeln('Slojnost teksta: ',s); {Вывод сложности} readln; end. И на Basic CLS INPUT "Vvedite tekst: ", t$ n = LEN(t$) s = 1 FOR i = 1 TO n k = VAL(MID$(t$, i, 1)) IF (k < 48) OR (k > 57 AND k < 65) OR (k > 90 AND k < 97) OR (k > 122 AND k < 128) OR (k > 175 AND k < 224) OR (k > 239) THEN s = s + 1 NEXT i PRINT "Slojnost teksta: "; s END

Отправлен: 30.04.2008, 10:52 Вопрос задал: Lomm (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 23)

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Lomm! 2. в VB (VBA) код может выглядеть, как в приложении, для "Basic" потребуется небольшая редакция. Приложение: Sub ddd() 'CLS t = InputBox("Vvedite tekst: ") n = Len(t) s = 1 For i = 1 To n k = Asc(Mid$(t, i, 1)) Select Case k Case Is < 48, 57 To 65, 91 To 96, 123 To 127, 176 To 223, Is > 239 s = s + 1 End Select Next i Debug.Print "Slojnost teksta: ", s End End Sub

Ответ отправил: Тесленко Евгений Алексеевич (статус: Студент) Ответ отправлен: 01.05.2008, 12:13 Оценка за ответ: 5 Комментарий оценки: Спасибо

Отвечает: Черников Игорь Владимирович Здравствуйте, Lomm! Вот ответ на первый вопрос, извините, что с небольшим опозданием. выполнен на QBasic DIM stroka AS STRING DIM otvet AS STRING DIM temp AS STRING DIM schetchik AS LONG DIM i AS LONG DIM popravka AS LONG stroka = "2sd5qwert3qwe1q9qwertyuio" n = LEN(stroka) FOR i = 1 TO n schetchik = schetchik + 1 temp = MID$(stroka, i, 1) IF VAL(temp) <> 0 THEN popravka = popravka + LEN(STR$(schetchik)) - 1 otvet = otvet + STR$(schetchik + popravka) ELSE otvet = otvet + MID$(stroka, i, 1) END IF NEXT i PRINT otvet --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: Студент) Ответ отправлен: 02.05.2008, 17:38 Оценка за ответ: 5 Комментарий оценки: Наверно вы поняли задание лучше меня

Вопрос № 134.966

Доброго времени суток! Помогите, пожалуйста разобраться в вопросе: как убрать незначащие нули и повтор знака-разделителя в текстбоксе математической программе... С благодарностью Сергей.

Отправлен: 01.05.2008, 22:24 Вопрос задал: Maksimtsev S.I. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Maksimtsev S.I.! процедура в приложении поможет организовать правильный числовой ввод в поле формы. в процедуру обработки потери фокуса (LostFocus) поместите строку подобную предложеной Игорем Владимировичем Черниковым она избавит поле от лидирующих нулей. Евгений. Приложение: Private Sub Text1_KeyPress(ByVal KeyAscii As Integer) Dim s$ s = Text1.Text Select Case KeyAscii Case 48 To 57 Case 44, 46 KeyAscii = 44 '44, 46 - запятая или точка, согласно национальным настройкам системы If InStr(s, Chr(KeyAscii)) > 1 Then KeyAscii = 0 'запрет повторения разделителя If Len(s) = 0 Then KeyAscii = 0 'запрет лидирующего разделителя Case Else KeyAscii = 0 End Select End Sub

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

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