Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Visual Basic (VB).

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61

Открыть новую тему     Написать ответ в эту тему

NEOMATRIX



Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору


Данный топик предназначен только для обсуждения типовых задач на Visual Basic.
Обсуждение задач на VBA (а именно, Excel, Word, Access) строго запрещено!
Пишите в соответствующих топиках.

 
Родственные топики:
  • Excel VBA - часть 1, часть 2 - все вопросы по Excel VBA туда
  • Word VBA все вопросы по Word VBA туда
  • Access все вопросы по программированию в Access туда
  • VBScript - программирование "удобняшек" на VBScript
  • QBasic - типовые задачи на QBasic
     
  • Date Time Functions In Visual Basic
  • VB6's Trig, Math, Financial, Boolean, and Random functions
  • Visual Basic 6 String Functions
  • VB6 Number System Functions (Hex, Oct, Etc)
  • VB6's DateAdd function
     
  • Functions (Visual Basic)
  • Keywords and Members by Task
  • Visual Basic Reference
     
  • Visual Basic String Manipulation Tutorials
     
  • Top 10 Visual Basic Sins

     
    Учебники:
    Visual Basic для студентов и школьников. Культин Н. (2010)
    Занимательное программирование на Visual Basic.NET. Климов А. (2005)
    Visual Basic в задачах и примерах. Сафронов (2009)
    Visual Basic 2012 на примерах. Зиборов В. (2012)

  • Всего записей: 202 | Зарегистр. 29-12-2004 | Отправлено: 19:30 16-11-2005 | Исправлено: XPerformer, 10:07 28-10-2014
    driverok



    Junior Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Помогите решить на VBA следующую задачу:
    Вычислить значения функции y=cos(kx)+a и Z=sin(kx^2) для каждого K, изменяющегося от 1 до 10. Определить сумму положительных значений функции y=cos(kx)+a.
    Вывод результата расчета организовать с помощью встроенной процедуры MsgBox и в окно Immediate с использованием функции Format.
     
    Заранее всем спасибо!

    Всего записей: 91 | Зарегистр. 02-08-2004 | Отправлено: 11:29 05-01-2007
    Cassanius



    Junior Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Заработало. Будет полезно всем кто хочет сохранять приходящие сообщения в какой-либо папке вне Outlooka (в данном примере New Folder на диске С):
     
    Sub RunAScriptRuleRoutine(MyMail As MailItem)
        Dim strID As String
        Dim olNS As Outlook.NameSpace
        Dim oMail As Outlook.MailItem
        Dim strSaveName As String
        Dim strFolderPath As String
         
         
        strID = MyMail.EntryID
        Set olNS = Application.GetNamespace("MAPI")
        Set oMail = olNS.GetItemFromID(strID)
        ' do stuff with oMail, e.g.
        MsgBox oMail.Subject
        strSaveName = oMail.Subject & ".msg"
        strFolderPath = "C:\New Folder\"
        MyMail.SaveAs strFolderPath & strSaveName, olMSG
     
       
        Set olNS = Nothing
    End Sub
     
    Сделал модификацию кода в соответствии с этой подсказкой:
    To take advantage of the fact that the Application object in Outlook VBA is trusted, a VBA procedure designed to be executed as a "run a script" rule action from the Rules Wizard needs to use the EntryID of the VBA procedure's MailItem or MeetingItem argument to get the desired item as an object derived from the Application object, rather than use the item passed as an argument

    Всего записей: 158 | Зарегистр. 13-11-2003 | Отправлено: 13:15 08-01-2007
    Troitsky



    Водник Водкин
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    driverok

    Код:
      Dim k As Integer
      Dim y As Double, z As Double
      Dim x As Double, a As Double
      Dim dblSum As Double
       
      x = 0.123
      a = 4.567
      dblSum = 0
       
      For k = 1 To 10
        y = Cos(k * x) + a
        z = Sin(k * x ^ 2)
        Debug.Print "k = " & CStr(k) & " -> y = " & Format(y, "0.000") & "; z = " & Format(z, "0.000")
        If y > 0 Then dblSum = dblSum + y
      Next k
       
      MsgBox "сумма положительных значений функции y=cos(kx)+a=" & Format(dblSum, "#.000")



    ----------
    Мы в хорошем настроении гуляем по лесам.
    Кто обидеть нас захочет – сам получит по усам.
    Сам полу- получит по усам. Сам полу- получит по усам!

    Всего записей: 795 | Зарегистр. 13-12-2003 | Отправлено: 14:09 08-01-2007
    Salya Romanov

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Люди помогите оформить 2 условия:
    1. заменит первые  k элементов массива на те же элементы в обратном порядке;
    2. удалить строку и столбец на пересечении которых находится максимальный элемент массива.
     В программировании дуб, уже неделю над этим бьюсь.......

    Всего записей: 3 | Зарегистр. 22-01-2007 | Отправлено: 19:34 22-01-2007
    Legio



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору

    Цитата:
    1. заменит первые  k элементов массива на те же элементы в обратном порядке;


    Код:
     
    Option Explicit
     
    Sub aChange(ByRef a())
    Dim i As Integer, uLimit As Single, t
     
        If LBound(a) = UBound(a) Then Exit Sub
         
        i = LBound(a)
        uLimit = (UBound(a) + LBound(a)) / 2
         
        Do While (i <= uLimit)
         
            t = a(i)
            a(i) = a(UBound(a) - i + LBound(a))
            a(UBound(a) - i + LBound(a)) = t
         
            i = i + 1
         
        Loop
     
    End Sub
     
    Private Sub Form_Load()
    Dim i As Integer, a()
     
        ReDim a(2 To 4)
         
        a(2) = 1
        a(3) = 2
        a(4) = 3
     
    '    For i = LBound(a) To UBound(a)
         
    '        MsgBox a(i)
         
    '    Next
         
        Call aChange(a)
         
    '    For i = LBound(a) To UBound(a)
         
    '        MsgBox a(i)
         
    '    Next
     
    End Sub
     

    в VB6 работает =__=
     

    Цитата:
    2. удалить строку и столбец на пересечении которых находится максимальный элемент массива.

    В каком смысле удалить?.. Новый массив создать, нулями заполнить, в старом элементы подвинуть/размерность изменить?

    ----------
    Side? I'm on nobody's side, because nobody is on my side...

    Всего записей: 695 | Зарегистр. 01-08-2003 | Отправлено: 20:24 22-01-2007
    Salya Romanov

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

    Цитата:
    В каком смысле удалить?.. Новый массив создать, нулями заполнить, в старом элементы подвинуть/размерность изменить?

     
    в смысле 1-ое условие для одномерного массива, а второе для двумерного. Дан массив  n * m и из него надо удалить строку и столбец на пересечении которых находится максимальный элемент массива.

    Всего записей: 3 | Зарегистр. 22-01-2007 | Отправлено: 20:46 22-01-2007
    Legio



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Salya Romanov
    В каком смысле удалить?.. Именно строку/столбец удалить, с переопределением размерностей массива? Или чего?

    ----------
    Side? I'm on nobody's side, because nobody is on my side...

    Всего записей: 695 | Зарегистр. 01-08-2003 | Отправлено: 23:28 22-01-2007
    Salya Romanov

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Legio

    Цитата:
    В каком смысле удалить?.. Именно строку/столбец удалить, с переопределением размерностей массива? Или чего?

     Видимо так оно и есть, хотя ничего конкретного в условии не говорится, просто удалить строку и столбец...

    Всего записей: 3 | Зарегистр. 22-01-2007 | Отправлено: 09:38 23-01-2007
    Troitsky



    Водник Водкин
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Salya Romanov
    Legio

    Цитата:
    1. заменит первые  k элементов массива на те же элементы в обратном порядке

    Может лучше так:
    Код:
      Dim a(0 To 27) As Integer ' массив
      Dim i As Integer          ' счетчик
      Dim k As Integer          ' сколько элементов заменять
      Dim intLB As Integer      ' нижняя граница массива
       
      intLB = LBound(a)
       
      For i = intLB To UBound(a)
        a(i) = i  ' заполняем массив числами
      Next i
       
      k = 21
       
      ' заменяем первые k элементов на те же в обратном порядке
      For i = intLB To intLB + Int(k / 2) - 1
        a(i) = a(i) Xor a(intLB + k - i - 1)
        a(intLB + k - i - 1) = a(i) Xor a(intLB + k - i - 1)
        a(i) = a(i) Xor a(intLB + k - i - 1)
      Next i
    ?


    ----------
    Мы в хорошем настроении гуляем по лесам.
    Кто обидеть нас захочет – сам получит по усам.
    Сам полу- получит по усам. Сам полу- получит по усам!

    Всего записей: 795 | Зарегистр. 13-12-2003 | Отправлено: 11:12 23-01-2007
    Legio



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Troitsky
    Да... Эту часть забыл
     
    Добавлено:
    тогда так
     

    Код:
    Option Explicit
     
    Sub aChange(ByRef a(), k As Integer)
    Dim i As Integer, t
     
        If LBound(a) = UBound(a) Then Exit Sub
         
        i = LBound(a)
        If k > Abs((UBound(a) - LBound(a)) / 2) Then k = Abs((UBound(a) - LBound(a)) / 2)
     
        For i = LBound(a) To (LBound(a) + k - 1)
         
            t = a(i)
            a(i) = a(UBound(a) - i + LBound(a))
            a(UBound(a) - i + LBound(a)) = t
         
        Next
     
    End Sub
     
    Private Sub Form_Load()
    Dim i As Integer, a()
     
        ReDim a(2 To 7)
         
        a(2) = 1
        a(3) = 2
        a(4) = 3
        a(5) = 4
        a(6) = 5
        a(7) = 6
         
    '    For i = LBound(a) To UBound(a)
         
    '        MsgBox a(i)
         
    '    Next
         
        Call aChange(a, 2)
         
    '    For i = LBound(a) To UBound(a)
         
    '        MsgBox a(i)
         
    '    Next
         
    End Sub
     


    ----------
    Side? I'm on nobody's side, because nobody is on my side...

    Всего записей: 695 | Зарегистр. 01-08-2003 | Отправлено: 18:11 23-01-2007
    BlackFoxBay

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Кто знает как в VBA активировать какую-нить процедуру по двойному клику мыши-DoubleClick? ну чтоб, там, форма выскакивала какая-нить или мессага?. Заранее спасибо.

    Всего записей: 2 | Зарегистр. 02-02-2007 | Отправлено: 08:01 02-02-2007
    AndronH



    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    excel
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'код тут
    End Sub
     
    есть соображения что можно сделать хук мыши, и следить где тыкается, но это уже не чистый VBA

    Всего записей: 21 | Зарегистр. 14-12-2006 | Отправлено: 11:36 02-02-2007
    zelinski



    BANNED
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Есть текстовый файл. В нём строки. Длинна строк различная. От сотни до пятисот (примерно) буковок. Как создать новый файл, в котором были бы строки из первого файла в отсортированном виде (по первым 20 символам строк)? Для VB версии 3.

    Всего записей: 471 | Зарегистр. 24-04-2003 | Отправлено: 18:37 02-02-2007
    jONES1979



    Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    zelinski
     
    Вот общий принцип. переделка скрипта от www.microsoft.com/technet/scriptcenter
    строка разбивается на значимую часть(первый 20 символов) и вторую незначимую остаток). Строки записываются в память "виртуального" ADOR.Recordset и там сортируются...
    Единственное, я не знаю поддерживает ли ADOR.Recordset строковые поля длиной более 255 символов. Опытным путём не на чем выяснять да и не охото...
     
    Если не поддерживает, то тебе просто строку придется делить не на две, а на три части...
     
    Подробнее...

    Всего записей: 324 | Зарегистр. 20-05-2005 | Отправлено: 12:46 04-02-2007
    AndronH



    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    если длинна строк не очень большая то думаю чтоб не парится можно юзать лист с sorted=true
     
     
    Private Sub Command2_Click()
    List1.AddItem "Cweqweqwcqwq"
    List1.AddItem "Aweqweqwcqwq"
    List1.AddItem "Bweqweqwcqwq"
    List1.AddItem "Dweqweqwcqwq"
    For X = 0 To List1.ListCount - 1
    Debug.Print X
    Next X
    End Sub
     

    Всего записей: 21 | Зарегистр. 14-12-2006 | Отправлено: 10:49 05-02-2007 | Исправлено: AndronH, 11:20 05-02-2007
    BlackFoxBay

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

    Цитата:
    [/q]
    [q]excel  
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)  
    'код тут  
    End Sub

     
    Спасибо!
    Сработало!

    Всего записей: 2 | Зарегистр. 02-02-2007 | Отправлено: 16:54 05-02-2007
    danka



    Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Помогите !
     Для VB версии 6
     Есть бланки платежек. В них есть несколько окон в которые надо попасть при распечатке на принтере. Каким шрифтом все равно . Лиш бы попадало в окошко и там между цифрами были небольшие пробелы, т.к. я пытался вписывать разными размерами фонтов. Не получаеться. Так подсчитал что если между числом вводить пробел примерно на 30-40% от толшины цифры , то должно попадать в нужные места.
     Распечатывал н а принтер вот таким кодом:
     Private Sub BtnPrint_Click()
        Printer.ScaleMode = 1
        Printer.FontSize = 14
        Printer.CurrentX = 3586
        Printer.CurrentY = 2604
        Printer.Print TxtBox1
        ....................TxtBox2
        ....................TxtBox3
        ....................TxtBox4
         
        Printer.EndDoc
    End Sub
     

    Всего записей: 325 | Зарегистр. 16-05-2005 | Отправлено: 18:31 05-02-2007
    AndronH



    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Private Sub Command1_Click()
        Text1.Text = "ANDRON"
        Z = 600
        Printer.ScaleMode = 1
        Printer.FontSize = 14
        For X = 1 To Len(Text1.Text)
        Printer.CurrentX = 3386 + X * Z
        Printer.CurrentY = 2604
        Printer.Print Mid(Text1, X, 1)
        Next X
        Printer.EndDoc
    End Sub
     
    Параметр Z подобрать опционально, рекомендую использовать моноширинный шрифт.

    Всего записей: 21 | Зарегистр. 14-12-2006 | Отправлено: 14:58 07-02-2007
    ppJester

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    помогите пожалуйсто! нужно осуществить следующее: во время выполнения вводим в текстбокс формулу произвольную (например y=x^2-5), нужно в ходе выполнения вытащить эту самую формулу и при заданном позднее значении х вычислять чему будет равен y
    то есть программа, которая вычисляет значения произвольных формул

    Всего записей: 2 | Зарегистр. 10-02-2007 | Отправлено: 22:33 10-02-2007 | Исправлено: ppJester, 22:34 10-02-2007
    Legio



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    ppJester
    Вы бы еще AI написать попросили.
    Несколько больших подробностей треба.

    ----------
    Side? I'm on nobody's side, because nobody is on my side...

    Всего записей: 695 | Зарегистр. 01-08-2003 | Отправлено: 22:38 10-02-2007
    Открыть новую тему     Написать ответ в эту тему

    Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61

    Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Visual Basic (VB).


    Реклама на форуме Ru.Board.

    Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
    Modified by Ru.B0ard
    © Ru.B0ard 2000-2024

    BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

    Рейтинг.ru