ActiveSheet.Name = CStr(frmEditFirm.txtNaim.Text)

ActiveSheet.Range("B1").Value = frmEditFirm.txtAdr.Text

ActiveSheet.Range("C1").Value = frmEditFirm.txtTel1.Text

ActiveSheet.Range("D1").Value = frmEditFirm.txtTel2.Text

ActiveSheet.Range("E1").Value = ""

ActiveSheet.Range("E1").Value = frmEditFirm.txtSite.Text

ActiveSheet.Range("E1").Hyperlinks.Add Anchor:=ActiveSheet.Range("E1"), Address:="http://" & frmEditFirm.txtSite.Text

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

End Sub

Sub DeleteFirm()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

Application.DisplayAlerts = False

string1 = "Firms.xls"

If ActiveSheet.Name = "1" Or ActiveWorkbook.Name <> CStr(string1) Then

MsgBox "Выберите (активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"

Exit Sub

End If

i = MsgBox("Удаляем фирму (" & ActiveSheet.Name & ")?", vbInformation + vbOKCancel, "Внимание!")

If i = 1 Then

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

x = ActiveSheet.Index

ActiveSheet.Delete

For i = x To Worksheets.Count

Names.Add Name:="End" & i, RefersTo:=Worksheets(i).Range("End" & i + 1), Visible:=True

Names.Add Name:="Beg" & i, RefersTo:=Worksheets(i).Range("Beg" & i + 1), Visible:=True

Next i

Application.DisplayAlerts = True

Else

Exit Sub

End If

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

End Sub

Public Sub ShowList()

ex = 1

listFirm.Show

If ex = 0 Then Exit Sub

End Sub

Sub NewFirmLo()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

Workbooks("Firms").Worksheets("1").Activate

ex = 1

NewFirm.Show

If ex = 0 Then Exit Sub

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

End Sub

Sub EditPut()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

string1 = "Firms.xls"

If ActiveSheet.Name = "1" Or ActiveWorkbook.Name <> CStr(string1) Then

MsgBox "Выберите (активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"

Exit Sub

End If

ex = 1

num = Workbooks("Firms.xls").ActiveSheet.Index

ie = Workbooks("Firms.xls").ActiveSheet.Range("End" & num).Row

If ie = 6 Then

MsgBox "В базе нет путевок - нечего редактировать.", vbCritical, "Ошибка!"

Exit Sub

End If

frmSelPut.CommandButton5.Visible = True

frmSelPut.Show

If ex = 0 Then Exit Sub

ex = 1

temp = ActiveCell.Row

gorod = Cells(temp, 1)

i = temp

Do While Cells(i, 1).MergeCells = False

i = i - 1

Loop

frmPInfo.Label1.Caption = ActiveSheet.Name

frmPInfo.TextBox1.Text = Cells(i, 1).Value

frmPInfo.TextBox2.Text = gorod

frmPInfo.TextBox3.Text = Cells(temp, 2).Value

frmPInfo.TextBox5.Text = Cells(temp, 3).Value

frmPInfo.TextBox4.Text = Cells(temp, 4).Value

frmPInfo.TextBox6.Text = Cells(temp, 5).Value

frmPInfo.TextBox7.Text = Cells(temp, 6).Value

frmPInfo.TextBox8.Text = Cells(temp, 8).Value

frmPInfo.TextBox9.Text = Cells(temp, 10).Value

If Cells(temp, 7).Value = 7 Then frmPInfo.OptionButton1 = True

If Cells(temp, 7).Value = 14 Then frmPInfo.OptionButton2 = True

If Cells(temp, 7).Value = 21 Then frmPInfo.OptionButton3 = True

If Cells(temp, 9).Value = 1 Then frmPInfo.OptionButton4 = True

If Cells(temp, 9).Value = 2 Then frmPInfo.OptionButton6 = True

If Cells(temp, 9).Value = 3 Then frmPInfo.OptionButton7 = True

If Cells(temp, 9).Value = 4 Then frmPInfo.OptionButton8 = True

If Cells(temp, 9).Value = 5 Then frmPInfo.OptionButton5 = True

frmPInfo.Show

If ex = 0 Then Exit Sub

With frmPInfo

If .TextBox5.Value = "" Then .TextBox5.Value = 0

If .TextBox6.Value = "" Then .TextBox6.Value = 0

If .TextBox7.Value = "" Then .TextBox7.Value = 0

If .TextBox3.Value = "" Then .TextBox3.Value = 0

If .TextBox4.Value = "" Then .TextBox4.Value = 0

Cells(temp, 3).Value = CDbl(.TextBox5.Value)

Cells(temp, 5).Value = CDbl(.TextBox6.Text)

Cells(temp, 6).Value = CDbl(.TextBox7.Text)

Cells(temp, 2).Value = CInt(.TextBox3.Text)

Cells(temp, 4).Value = CInt(.TextBox4.Text)

Cells(temp, 8).Value = CStr(.TextBox8.Text)

Cells(temp, 10).Value = CStr(.TextBox9.Text)

If .OptionButton1 = True Then

Cells(temp, 7).Value = CInt(7)

End If

If .OptionButton2 = True Then

Cells(temp, 7).Value = CInt(14)

End If

If .OptionButton3 = True Then

Cells(temp, 7).Value = CInt(21)

End If

If .OptionButton4 = True Then

Cells(temp, 9).Value = CInt(1)

End If

If .OptionButton5 = True Then

Cells(temp, 9).Value = CInt(5)

End If

If .OptionButton6 = True Then

Cells(temp, 9).Value = CInt(2)

End If

If .OptionButton7 = True Then

Cells(temp, 9).Value = CInt(3)

End If

If .OptionButton8 = True Then

Cells(temp, 9).Value = CInt(4)

End If

End With

frmPInfo.Label1.Caption = ""

frmPInfo.TextBox1.Text = ""

frmPInfo.TextBox2.Text = ""

frmPInfo.TextBox3.Text = ""

frmPInfo.TextBox4.Text = ""

frmPInfo.TextBox5.Text = ""

frmPInfo.TextBox6.Text = ""

frmPInfo.TextBox7.Text = ""

frmPInfo.TextBox8.Text = ""

frmPInfo.TextBox9.Text = ""

frmPInfo.OptionButton1 = False

frmPInfo.OptionButton2 = False

frmPInfo.OptionButton3 = False

frmPInfo.OptionButton4 = False

frmPInfo.OptionButton5 = False

frmPInfo.OptionButton6 = False

frmPInfo.OptionButton7 = False

frmPInfo.OptionButton8 = False

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

End Sub

Sub DeleteCoun()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

string1 = "Firms.xls"

If ActiveSheet.Name = "1" Or ActiveWorkbook.Name <> CStr(string1) Then

MsgBox "Выберите (активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"

Exit Sub

End If

num = Workbooks("Firms.xls").ActiveSheet.Index

ie = Workbooks("Firms.xls").ActiveSheet.Range("End" & num).Row

If ie = 6 Then

MsgBox "В базе нет путевок - нечего удалять.", vbCritical, "Ошибка!"

Exit Sub

End If

ex = 1

frmDelCoun.Show

If ex = 0 Then Exit Sub

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

Range("A1").Select

End Sub

Sub ShowCountry()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

string1 = "Firms.xls"

If ActiveSheet.Name = "1" Or ActiveWorkbook.Name <> CStr(string1) Then

MsgBox "Выберите (активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"

Exit Sub

End If

num = Workbooks("Firms.xls").ActiveSheet.Index

ie = Workbooks("Firms.xls").ActiveSheet.Range("End" & num).Row

If ie = 6 Then

MsgBox "В базе нет путевок - нечего искать.", vbCritical, "Ошибка!"

Exit Sub

End If

ex = 1

frmSelPut.Show

If ex = 0 Then Exit Sub

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

End Sub

Sub SubMainS()

Workbooks("Firms.xls").Worksheets("1").Activate

SubMain.Show

Размещено на Allbest.ru