Личный хомяк Максима

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » Личный хомяк Максима » VBA » Программа - вопросник для охранников (VBA в Excel)


Программа - вопросник для охранников (VBA в Excel)

Сообщений 1 страница 4 из 4

1

Знакомый чел попросил написать программу, которая выдает на экран форму, содержащую вопрос и три поля. Я ленивый черт и написал простейшую фигню в экселе. Потом было три доработки, но опять же все корявенько и страшненько - выкидывать уже написанное было страшно лень )))
Буду ждать комментариев ))))

0

2

Экспортированная форма

Код:
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1 
   Caption         =   "Вопросник"
   ClientHeight    =   5280
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10080
   OleObjectBlob   =   "UserForm1.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "UserForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim data_(200, 60)
Dim Odd(40, 4)
Dim i(10)
Dim m
Dim x
Dim lb

Private Sub CommandButton1_Click()
tmp = Worksheets("Вопросики").Cells(i(m) + 1, 3)

If Worksheets("Вопросики").Cells(i(m) + 1, 3) = "Да" Then
        i(m) = -1
    Else
        lb = lb + 1
        Odd(4 * (lb - 1) + 0, 2) = Mid(Worksheets("Вопросики").Cells(i(m) + 1, 2), 1, 100)
        Odd(4 * (lb - 1) + 1, 2) = Mid(Worksheets("Вопросики").Cells(i(m) + 1, 2), 101, 100)
        Odd(4 * (lb - 1) + 2, 2) = Mid(Worksheets("Вопросики").Cells(i(m) + 1, 2), 201, 100)
'        UserForm2.ListBox1.List(ib, 0) = Worksheets("Вопросики").Cells(i(m) + 1, 2)
        Odd(4 * (lb - 1) + 0, 0) = m
        Odd(4 * (lb - 1) + 0, 1) = i(m)
        Odd(4 * (lb - 1) + 0, 3) = Worksheets("Вопросики").Cells(i(m) + 1, 3)
        i(m) = 0
End If

m = m + 1

x = Вопросы()

End Sub

Private Sub CommandButton2_Click()
tmp = Worksheets("Вопросики").Cells(i(m) + 1, 3)

If Worksheets("Вопросики").Cells(i(m) + 1, 3) = "Нет" Then
        i(m) = -1
    Else
        lb = lb + 1
        Odd(4 * (lb - 1) + 0, 2) = Mid(Worksheets("Вопросики").Cells(i(m) + 1, 2), 1, 100)
        Odd(4 * (lb - 1) + 1, 2) = Mid(Worksheets("Вопросики").Cells(i(m) + 1, 2), 101, 100)
        Odd(4 * (lb - 1) + 2, 2) = Mid(Worksheets("Вопросики").Cells(i(m) + 1, 2), 201, 100)
'        UserForm2.ListBox1.List(ib, 0) = Worksheets("Вопросики").Cells(i(m) + 1, 2)
        Odd(4 * (lb - 1) + 0, 0) = m
        Odd(4 * (lb - 1) + 0, 1) = i(m)
        Odd(4 * (lb - 1) + 0, 3) = Worksheets("Вопросики").Cells(i(m) + 1, 3)
        i(m) = 0
End If

m = m + 1

x = Вопросы()

End Sub

Function Вопросы()

3:

If m = 11 Or m = 0 Then

y = (i(1) + i(2) + i(3) + i(4) + i(5) + i(6) + i(7) + i(8) + i(9) + i(10)) * -1

If m = 11 Then
    
For z = 1 To 10

If i(z) > 0 Then
m = z
GoTo 4
End If

Next z
    
    x = MsgBox("Правильных - " & y, vbOKOnly)
    UserForm2.ListBox1.List() = Odd
    UserForm2.Show

End If

m = 1
lb = 0
i(1) = FormatNumber(Rnd * (367 - 1) + 1, 0)
        Odd(0, 2) = ""
        Odd(1, 2) = ""
        Odd(2, 2) = ""
        Odd(0, 0) = ""
        Odd(0, 1) = ""
        Odd(0, 3) = ""

j = 2

start:
     i(j) = FormatNumber(Rnd(1) * (367 - 1) + 1, 0)
     For k = 1 To j - 1
         If i(j) = i(k) Then GoTo start
     Next k
        
        Odd(4 * (j - 1) + 0, 2) = ""
        Odd(4 * (j - 1) + 1, 2) = ""
        Odd(4 * (j - 1) + 2, 2) = ""
        Odd(4 * (j - 1) + 0, 0) = ""
        Odd(4 * (j - 1) + 0, 1) = ""
        Odd(4 * (j - 1) + 0, 3) = ""
    
    j = j + 1

If j = 11 Then Else GoTo start

End If

For z = m To 10

If i(z) > 0 Then
m = z
GoTo 4
End If
Next z

m = 11
GoTo 3

4:

UserForm1.TextBox1.Value = Worksheets("Вопросики").Cells(i(m) + 1, 2)
UserForm1.Label1.Caption = "Вопрос " & m & " из 10 (№ " & i(m) & ")"

End Function

Private Sub CommandButton3_Click()

m = m + 1

x = Вопросы()
End Sub

Private Sub UserForm_Initialize()
m = 0
x = Вопросы()
End Sub

0

3

Краткое содержание файла экселя - на первой странице кнопка, с кодом

Код:
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub

Внизу приписка - "Если будет ругаться на макросы, то или разрешить,
или Сервис-Параметры-Безопасность-Безопасность макросов-Низкая"

Вторая страница называется "вопросики", на ней в виде таблицы
№ / Вопрос /ответ
1 / Оружие - это устройства и предметы, конструктивно предназначенные для поражения живой или иной цели, подачи сигналов / Да

Всего 367 пунктов.

0

4

Забыл упомянуть - это самый галимый код, который я писал в своей жизни, экспериментируя с формами )))

0


Вы здесь » Личный хомяк Максима » VBA » Программа - вопросник для охранников (VBA в Excel)