Программный код

Dim t1 As Boolean

Dim t2 As Boolean

Private Sub CommandButton1_Click() 'Загрузить таблицу 1'

Me.ListBox1.Clear

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim i As Integer

Dim j As Integer

Dim y As Integer

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "Select * From Tab_1"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn

i = 1

y = rs.Fields.Count - 1

Me.ListBox1.ColumnCount = y + 1

While Not (rs.EOF)

For j = 0 To y

Me.ListBox1.AddItem ""

Me.ListBox1.List(0, 0) = "Код предприятия"

Me.ListBox1.List(0, 1) = "Название"

Me.ListBox1.List(0, 2) = "Адрес"

Me.ListBox1.AddItem ""

Me.ListBox1.List(i, j) = rs.Fields(j)

Next j

i = i + 1

t1 = True

rs.MoveNext

Wend

rs.Close

cn.Close

End Sub

Private Sub CommandButton17_Click()

UserForm5.Show

End Sub

______________________________________________________________

Private Sub CommandButton2_Click() 'Загрузить таблицу 2'

Me.ListBox2.Clear

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim i As Integer

Dim j As Integer

Dim y As Integer

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "Select * From Tab_2"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

i = 1

y = rs.Fields.Count - 1

Me.ListBox2.ColumnCount = y + 1

While Not (rs.EOF)

For j = 0 To y

Me.ListBox2.AddItem ""

Me.ListBox2.List(0, 0) = "Код"

Me.ListBox2.List(0, 1) = "Вид продукции"

Me.ListBox2.List(0, 2) = "Квартал1"

Me.ListBox2.List(0, 3) = "Квартал2"

Me.ListBox2.List(0, 4) = "Квартал3"

Me.ListBox2.List(0, 5) = "Квартал4"

Me.ListBox2.List(1, 6) = "Средняя цена"

Me.ListBox2.AddItem ""

Me.ListBox2.List(i, j) = rs.Fields(j)

Next j

i = i + 1

t2 = True

rs.MoveNext

Wend

rs.Close

cn.Close

End Sub

____________________________________________________________________

Private Sub CommandButton13_Click() 'Удалить из таблицы1'

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim l As Integer

Dim x As String

Dim i As Integer

Dim j As Integer

Dim y As Integer

If t1 = False Then

MsgBox "Сначало загрузите таблицу1", vbExclamation: Exit Sub

Else

For l = 0 To ListBox1.ListCount - 1

If Me.ListBox1.Selected(l) Then

x = Me.ListBox1.List(l)

End If

Next l

If x = "" Then

MsgBox "Выделите строку со значениями", vbExclamation: Exit Sub

Else

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "Delete Tab_1.Kod, Tab_1.Nazv, Tab_1.adr FROM Tab_1 WHERE ((Tab_1.Kod)=" & x & ");"

MsgBox "Данные успешно удалены"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

cn.Close

End If

End If

End Sub

____________________________________________________________________

Private Sub CommandButton14_Click() 'Удалить из таблицы2'

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim l As Integer

Dim x As String

Dim i As Integer

Dim j As Integer

Dim y As Integer

Dim q As String

If t2 = False Then

MsgBox "Сначала загрузите таблицу2", vbExclamation: Exit Sub

Else

For l = 0 To ListBox2.ListCount - 1

If Me.ListBox2.Selected(l) Then

x = Me.ListBox2.List(, 0)

q = Me.ListBox2.List(, 1)

End If

Next l

If x = "" Then

MsgBox "Выделите строку со значениями", vbExclamation: Exit Sub

Else

q = Chr(34) & q & Chr(34)

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "DELETE Tab_2.kod, Tab_2.vid, Tab_2.kv1, Tab_2.kv2, Tab_2.kv3, Tab_2.kv4, Tab_2.sred FROM Tab_2 WHERE (((Tab_2.Kod)=" & x & ") AND ((Tab_2.vid)=" & q & "));"

MsgBox "Данные успешно удалены"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

cn.Close

End If

End If

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'Редактор таблицы 1'

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim l As Integer

Dim x As String

Dim Na As String

Dim ad As String

Dim ko As String

Dim i As Integer

Dim j As Integer

Dim y As Integer

For l = 0 To ListBox1.ListCount - 1

If Me.ListBox1.Selected(l) Then

x = Me.ListBox1.List(l)

End If

Next l

If x = "" Then

MsgBox "Выделите строку со значениями", vbExclamation: Exit Sub

Else

ko = InputBox("Введите код предприятия")

Na = InputBox("Введите название")

ad = InputBox("Введите адрес")

If ko = Empty Or Na = Empty Or ad = Empty Then GoTo Oshibka

Na = Chr(34) & Na & Chr(34)

ad = Chr(34) & ad & Chr(34)

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "UPDATE Tab_1 SET Tab_1.Kod =" & ko & ", Tab_1.Nazv =" & Na & ", Tab_1.adr =" & ad & " WHERE (((Tab_1.Kod)=" & x & "));"

MsgBox "Данные успешно изменены"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

cn.Close

GoTo Konec

Oshibka:

MsgBox ("Введены не все значения.")

Konec:

End If

End Sub

____________________________________________________________________

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'Редактор таблицы 2'

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim l As Integer

Dim x As String

Dim y As String

Dim ko As String

Dim vi As String

Dim k1 As String

Dim k2 As String

Dim k3 As String

Dim k4 As String

Dim sre As String

Dim i As Integer

Dim j As Integer

Dim q As String

For l = 0 To ListBox2.ListCount - 1

If Me.ListBox2.Selected(l) Then

x = Me.ListBox2.List(, 0)

q = Me.ListBox2.List(, 1)

End If

Next l

If x = "" Then

MsgBox "Выделите строку со значениями", vbExclamation: Exit Sub

Else

q = Chr(34) & q & Chr(34)

ko = InputBox("Код?")

vi = InputBox("Вид?")

k1 = InputBox("Квартал1?")

k2 = InputBox("Квартал2?")

k3 = InputBox("Квартал3?")

k4 = InputBox("Квартал4?")

sre = InputBox("Средняя цена?")

If Not IsNumeric(ko) Or Not IsNumeric(k1) Or Not IsNumeric(k2) Or Not IsNumeric(k3) Or Not IsNumeric(k4) Or Not IsNumeric(sre) Then GoTo Oshibka

vi = Chr(34) & vi & Chr(34)

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "UPDATE Tab_2 SET Tab_2.Kod =" & ko & ", Tab_2.vid =" & vi & ", Tab_2.kv1 =" & k1 & ", Tab_2.kv2 =" & k2 & ", Tab_2.kv3 =" & k3 & ", Tab_2.kv4 =" & k4 & ", Tab_2.sred =" & sre & " WHERE (((Tab_2.Kod)=" & x & ") AND ((Tab_2.vid)=" & q & "));"

MsgBox "Данные успешно изменены"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

cn.Close

GoTo Konec

Oshibka:

MsgBox ("Введены не все значения или не соответсвует тип данных")

Konec:

End If

End Sub

____________________________________________________________________

Private Sub CommandButton16_Click() 'Добавить в таблицу1'

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim l As Integer

Dim x As String

Dim Na As String

Dim ad As String

Dim ko As String

Dim i As Integer

Dim j As Integer

Dim y As Integer

ko = InputBox("Введите код предприятия")

Na = InputBox("Введите название")

ad = InputBox("Введите адрес")

If ko = Empty Or Na = Empty Or ad = Empty Then GoTo Oshibka

Na = Chr(34) & Na & Chr(34)

ad = Chr(34) & ad & Chr(34)

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "INSERT INTO Tab_1 VALUES (" & ko & "," & Na & ", " & ad & ");"

MsgBox "Данные успешно изменены"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

cn.Close

GoTo Konec

Oshibka:

MsgBox ("Введены не все значения или не соответсвует тип данных")

Konec:

End Sub

____________________________________________________________________

Private Sub CommandButton15_Click() 'Добавить в таблицу2'

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim l As Integer

Dim x As Integer

Dim y As String

Dim ko As String

Dim vi As String

Dim k1 As String

Dim k2 As String

Dim k3 As String

Dim k4 As String

Dim sre As String

Dim i As Integer

Dim j As Integer

Dim q As String

ko = InputBox("Код?")

vi = InputBox("Вид?")

k1 = InputBox("Квартал1?")

k2 = InputBox("Квартал2?")

k3 = InputBox("Квартал3?")

k4 = InputBox("Квартал4?")

sre = InputBox("Средняя цена?")

If Not IsNumeric(ko) Or Not IsNumeric(k1) Or Not IsNumeric(k2) Or Not IsNumeric(k3) Or Not IsNumeric(k4) Or Not IsNumeric(sre) Then GoTo Oshibka

vi = Chr(34) & vi & Chr(34)

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "INSERT INTO Tab_2 VALUES (" & ko & ", " & vi & ", " & k1 & ", " & k2 & "," & k3 & "," & k4 & "," & sre & ");"

MsgBox "Данные успешно изменены"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

cn.Close

GoTo Konec

Oshibka:

MsgBox ("Введены не все значения или не соответсвует тип данных")

Konec:

End Sub

Private Sub CommandButton3_Click() 'Вывести данные о продукции выпуск которой непрерывно увеличивался'

UserForm2.ListBox1.Clear

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim i As Integer

Dim j As Integer

Dim y As Integer

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "SELECT Tab_2.kod, Tab_2.vid FROM Tab_2 WHERE (((kv1)<[kv2]) AND ((kv2)<[kv3]) AND ((kv3)<[kv4]));"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

i = 1

y = rs.Fields.Count - 1

UserForm2.ListBox1.ColumnCount = y + 1

While Not (rs.EOF)

For j = 0 To y

UserForm2.ListBox1.AddItem ""

UserForm2.ListBox1.List(0, 0) = "Код"

UserForm2.ListBox1.List(0, 1) = "Вид продукции"

UserForm2.ListBox1.AddItem ""

UserForm2.ListBox1.List(i, j) = rs.Fields(j)

Next j

i = i + 1

rs.MoveNext

Wend

rs.Close

cn.Close

UserForm2.Show

End Sub

____________________________________________________________________

Private Sub CommandButton4_Click() 'Сведения о годовом выпуске и годовой стоимости выпуска для произвольно заданного предприятия и определенной продукции.'

UserForm3.ListBox1.Clear

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim i As Integer

Dim j As Integer

Dim y As Integer

Dim x As String

Dim z As String

x = Chr(34) & InputBox("Введите название фирмы") & Chr(34)

z = Chr(34) & InputBox("Введите название продукции") & Chr(34)

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "SELECT [kv1]+[kv2]+[kv3]+[kv4] AS [Годовой выпуск], Tab_2.sred, Tab_1.Nazv, Tab_2.vid FROM Tab_1 INNER JOIN Tab_2 ON Tab_1.Kod = Tab_2.kod WHERE (((Tab_1.Nazv)=" & x & ") AND ((Tab_2.vid)=" & z & "));"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

i = 1

y = rs.Fields.Count - 1

UserForm3.ListBox1.ColumnCount = y + 1

While Not (rs.EOF)

For j = 0 To y

UserForm3.ListBox1.AddItem ""

UserForm3.ListBox1.List(0, 0) = "Годовой выпуск"

UserForm3.ListBox1.List(0, 1) = "Годовая стоимость выпуска"

UserForm3.ListBox1.List(0, 2) = "Название предприятия"

UserForm3.ListBox1.List(0, 3) = "Вид продукции"

UserForm3.ListBox1.AddItem ""

UserForm3.ListBox1.List(i, j) = rs.Fields(j)

Next j

i = i + 1

rs.MoveNext

Wend

rs.Close

cn.Close

UserForm3.Show

End Sub

____________________________________________________________________

Private Sub CommandButton5_Click() 'Суммарная стоимость выпуска для каждого предприятия'

UserForm4.ListBox1.Clear

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim i As Integer

Dim j As Integer

Dim y As Integer

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "SELECT Tab_2.Kod, Round(Sum(Tab_2.sred)) AS [Суммарная стоимость], Tab_1.nazv FROM Tab_1 INNER JOIN Tab_2 ON Tab_1.Kod = Tab_2.kod GROUP BY Tab_2.Kod, Tab_1.nazv;"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

i = 1

y = rs.Fields.Count - 1

UserForm4.ListBox1.ColumnCount = y + 1

While Not (rs.EOF)

For j = 0 To y

UserForm4.ListBox1.AddItem ""

UserForm4.ListBox1.List(0, 0) = "Код предприятия"

UserForm4.ListBox1.List(0, 1) = "Суммарная стоимость"

UserForm4.ListBox1.List(0, 2) = "Название предприятия"

UserForm4.ListBox1.AddItem ""

UserForm4.ListBox1.List(i, j) = rs.Fields(j)

Next j

i = i + 1

rs.MoveNext

Wend

rs.Close

cn.Close

UserForm4.Show

End Sub

Private Sub CommandButton6_Click() 'Уменьшение на 5% выпуска квартала 1 для заданного предприятия'

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim cmd As String

Dim sql As String

Dim x As String

x = Chr(34) & InputBox("Введите название фирмы") & Chr(34)

cmd = "Provider = Microsoft.Ace.OLEDB.12.0; Data Source =" & ActiveWorkbook.Path & "\BD.accdb;Persist Security Info=False"

sql = "UPDATE Tab_1 INNER JOIN Tab_2 ON Tab_1.Kod = Tab_2.kod SET Tab_2.kv1 = [kv1]-(([kv1]/100)*5) WHERE (((Tab_1.Nazv)=" & x & "));"

cn.ConnectionString = cmd

cn.Open

rs.Open sql, cn, adOpenDynamics

MsgBox ("Данные успешно обновлены")

End Sub

____________________________________________________________________

Private Sub CommandButton12_Click() 'Выход'

UserForm1.Hide

End Sub

Private Sub UserForm_Click()

Дата добавления: 2015-07-08