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

Выпуск № 761
от 24.04.2008, 07:05

Вопрос № 132.697

Доброго времени суток, уважаемые эксперты! Надеюсь на вашу помощь. Есть программа, переводящая числа из одной с/с в другую, изначально написанная на VB.NET. Я её пытался переписать на VB6, но постоянно выскакивают разные ошибки. Помогите разобраться начинающему. Текст программы - в приложении. Очень Вам благодарен! Приложение: Private Sub Command1_Click() Call osnova End Sub Sub osnova() 'основные вычисления 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 = Microsoft.VisualBasic.Left(chislo1, popolam - 1) chislo_2 = Mid(chislo1, popolam + 1) End Select sys1 = Combo1.Text sys2 = 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 Integer 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 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 Sub init() 'инициализация данных spisok = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.," End Sub

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

Отвечает: Черников Игорь Владимирович Здравствуйте, Lordaleksej! Вот попробовал всё исправить, кажется получалось. Удачи! Приложение: Dim priznak As Byte Dim spisok As String Private Sub Form_Load() For i = 2 To 36 Combo1.AddItem i Combo2.AddItem i Next i End Sub Private Sub Комманда1_Click() init Call osnova End Sub Sub osnova() Dim chislo_1 As String Dim sys1 As Double 'основные вычисления If Text1.Text = "" Then Label1 = "Число не введено!": 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) 'проверка допустимых символов 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 = Mid(chislo1, 1, popolam - 1) chislo_2 = Mid(chislo1, popolam + 1) End Select sys1 = CDbl(Combo1.Text) sys2 = 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 Integer 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 chislo_2 <> 0 Then chislo2 = znak & chislo_1 & "." & chislo_2 Else chislo2 = znak & chislo_1 End 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) 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 Sub init() 'инициализация данных spisok = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.," End Sub --------- От каждого по способностям, каждому по труду

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

Вопрос № 132.787

Добрый день, Уважаемые эксперты. в Excel создаю макрос, преднаначеный для отправки текущего листа, точнее выделеной его чести (Selection), в качестве ТЕЛА писма (НЕ attachment) с указанием адреса получателя письма , адреса получателя копии письма и темой письма. пробовал вопользоваться Reсord New Macro, но данный сервис смог "записать" только выделение ячеек, процесс обращения к меню Fail-Send To - Mail Recipient он не зафиксировал. Заранее благадарю.

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

Отвечает: Черников Игорь Владимирович Здравствуйте, Дорошкин Влад Алексеевич! Вот здесь есть описание, как это сделать http://rusfaq.ru/upload/509 Удачи! --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: Студент) Ответ отправлен: 19.04.2008, 17:50

Вопрос № 132.809

Вставляю программно некий рисунок в документ Word. В документе много рисунков. Необходимо сразу же выделить этот вставленный рисунок и добавить к нему альтернативный текст. Как добавить текст я знаю, но что-то затрудняюсь с выделением только что вставленного рисунка. Подскажите пожалуйста. Спасибо.

Отправлен: 18.04.2008, 12:00 Вопрос задал: Кокин Антон Вадимович (статус: 6-ой класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Черников Игорь Владимирович Здравствуйте, Кокин Антон Вадимович! При всавке рисунка, курсор устанавливается справа от него, поэтому попробуйте так: Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Выделится то, что слева от курсора. Удачи! --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: Студент) Ответ отправлен: 19.04.2008, 18:06 Оценка за ответ: 5 Комментарий оценки: Спасибо. Именно так. После того, как задал вопрос, сам дошурупил до этого.

Вопрос № 132.856

Уважаемые эксперты!помогите пожалуйста решить задачу!очень надо...заранее спасибо... ВЫполнить обработку элементов прямоугольной матрицы А, имеющей N строк и M столбцов.Просуммировать элементы каждой строки с элементами L-той строки.

Отправлен: 18.04.2008, 17:30 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Черников Игорь Владимирович Здравствуйте, Igor lukashov! Вот Ваша программа, будет непонятно - пишите! Удачи! Приложение: Sub Macr() Dim a() As Integer ' Объявляем массив Dim массив As String X = InputBox("Ведите количество столбцов в матрице", "Ввод данных") Y = InputBox("Ведите количество строк в матрице", "Ввод данных") ReDim a(X - 1, Y - 1) 'Объявляем размерность массива(матрицы) от = -10 'Заполняем массив случайными числами от 10 до 100 до = 10 For i = 0 To X - 1 For j = 0 To Y - 1 a(i, j) = ((до - от) * Rnd) + от массив = массив & a(i, j) & Space(Y - Len(CStr(a(i, j)))) & " " Next j 'Конец цикла массив = массив & Chr(10) Next i 'Конец заполнения массива z = InputBox("Введите № строки, которую нужно прибавить к остальным", "Ввод данных") массив = массив & Chr(10) & "Номер прибавленной строки - " & z & Chr(10) & Chr(10) For i = 0 To X - 1 If i <> z - 1 Then For j = 0 To Y - 1 a(i, j) = a(i, j) + a(z - 1, j) массив = массив & a(i, j) & Space(Y - Len(CStr(a(i, j)))) & " " Next j 'Конец цикла End If массив = массив & Chr(10) Next i 'Конец цикла 'Если указанную строку тоже нужно увеличить саму на себя, то добавим: массив = массив & Chr(10) & "Прибавленная строка:" & Chr(10) & Chr(10) For j = 0 To Y - 1 a(z - 1, j) = a(z - 1, j) + a(z - 1, j) массив = массив & a(z - 1, j) & Space(Y - Len(CStr(a(z - 1, j)))) & " " Next j MsgBox (массив) 'Выводим результат на экран, чтобы убедиться, что всё правильно End Sub --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: Студент) Ответ отправлен: 19.04.2008, 21:05 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо!))

Отвечает: Калашник Андрей Николаевич Здравствуйте, Igor lukashov! dim matrix(1 to n,1 to m) as long,l as long,i as long,j as long for i=1 to n for j=1 to m 'заполнение матрицы matrix(i,j)=int(rnd*1000) debug.print matrix(i,j) next next l=1 for i=1 to n for j=1 to m matrix(i,j)=matrix(i,j)+matrix(l,j) next next

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

Вопрос № 132.864

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

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

Отвечает: PsySex Здравствуйте, Ігор! Цитирую свой ответ на вопрос 62974. ==== В частности музыкального файла. Помещаем в файл ресурсов файла путем Add Custom Resuorce. Вообще в CUSTOM можно кидать любые типы файлов. Затем, когда нужно его проиграть, сохраняем его например во временную директорию и проигрываем. При закрытии проги удаляем свои сохраненные файлы. Вот подпрограмма сохранения файла на диск из ресурсов. ==================================================== Private Sub Extract(ID As Integer, Path As String) 'extracting resourses On Error Resume Next Dim file() As Byte file() = LoadResData(ID, "CUSTOM") Open Path For Binary Access Write As #1 Put #1, , file() Close #1 End Sub ===================================================== Параметры: ID-индетификатор ресурса, Path-путь с именем файла для сохранения(c: empmuzlo.mus) =========== Вообщем в проект добавляется файл ресурсов, а в него, в CUSTOM, помещается ваш ЕХЕ-файл, затем извлекается подпрограммой Extract в удобное место и затем его запускаете. --------- Bom Shankar!

Ответ отправил: PsySex (статус: Практикант) Ответ отправлен: 20.04.2008, 00:23

Отвечает: Черников Игорь Владимирович Здравствуйте, Ігор! Можно не только "запихнуть", но и создать! Примерно вот так это делается: puty = "c:" 'Путь к файлу NameFile = "Pausa.bat" 'Название файла Open puty + NameFile For Output As #1 'Создание и открытие нового файла Print #1, "Pause" 'Запись команды в файл Close #1 'Закрытие файла 'А вот так запускаем сделанный Батник: Shell puty + NameFile, vbNormalFocus Так же можно создать и маленький *.exe и запустить его, но это сложнее. Удачи! --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: Студент) Ответ отправлен: 20.04.2008, 11:57

Вопрос № 132.906

Доброе время суток. Такой вопрос, как узнать относительный путь к файлу. Например: программа находится в папке: C:folder1 Тогда относительный путь к файлу C:folder1folder2folder3file.ext должен быть таким folder2folder3file.ext

Отправлен: 19.04.2008, 00:07 Вопрос задал: Ігор (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Ігор! В VB путь размещения приложения определяется так: sPath = App.Path в Вашем случае конструкция будет такой: sPath = App.Path & "folder2folder3file.ext" Евгений.

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

Отвечает: Черников Игорь Владимирович Здравствуйте, Ігор! Судя по всему в исходной папке, в которой лежит исполняемый файл Вашей программы есть ещё несколько вложенных папок, которые перемещаются вместе с исходной. Тогда Евгений Алексеевич правильно Вам написал. Но если C:folder1folder2folder3file.ext остаётся на месте, а перемещается только C:folder1 с исполнительным файлом, тогда прав megaloman. Остановимся на первом варианте. В VB6 есть ещё и CurDir (текущий путь). В момент запуска программы в нём содержится путь до исполняемого файла программы и не меняется, пока не вызвать ChDir с аргументами, поэтому если Вам нужен исходный путь к программе, то вначале Вы можете записать его в переменную как у Евгения Алексеевича: sPath = CurDir тогда полный путь к файлу будет: ParentPathFile = CurDir + "folder2folder3file.ext" или так: ChDir "folder2" 'Переход во вложенную папку ChDir "folder3" ParentPathFile =CurDir + "file.ext" Вернуться в исходную папку можно так: ChDir sPath Удачи! --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: Студент) Ответ отправлен: 20.04.2008, 13:31

© 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