Программу склада с картинками в Excel VBA самим создать
Перечень производственных этапов и коды
0_Программу склада с картинками в Excel VBA самим создать_Вот как это работает
1_Программу склада с картинками в Excel VBA самим создать_Excel файл
2_Программу склада с картинками в Excel VBA самим создать_Cоздать маску ввода
3_Программу склада с картинками в Excel VBA самим создать_Создать лист Артикли
4_Программу склада с картинками в Excel VBA самим создать_Создать лист Журнал1
5_Программу склада с картинками в Excel VBA самим создать_Создать лист Накладная выхода артиклей
6_Программу склада с картинками в Excel VBA самим создать_Создать лист Cчета артиклей
7_Программу склада с картинками в Excel VBA самим создать_Создать лист Список
8_Программу склада с картинками в Excel VBA самим создать_Image1
9_Программу склада с картинками в Excel VBA самим создать_Label1
10_Программу склада с картинками в Excel VBA самим создать_Label2- Label4
11_Программу склада с картинками в Excel VBA самим создать_Frame1
12_Программу склада с картинками в Excel VBA самим создать_Image2
13_Программу склада с картинками в Excel VBA самим создать_Label5
14_Программу склада с картинками в Excel VBA самим создать_Label6- Label8
15_Программу склада с картинками в Excel VBA самим создать_Label9
16_Программу склада с картинками в Excel VBA самим создать_Label10- Label11
17_Программу склада с картинками в Excel VBA самим создать_ComboBox1
18_Программу склада с картинками в Excel VBA самим создать_CommandButton1
19_Программу склада с картинками в Excel VBA самим создать_19_CommandButton2
20_Программу склада с картинками в Excel VBA самим создать_Порядок активации в Frame1
21_Программу склада с картинками в Excel VBA самим создать_Frame2
22_Программу склада с картинками в Excel VBA самим создать_Label12
23_Программу склада с картинками в Excel VBA самим создать_Label13- Label19
24_Программу склада с картинками в Excel VBA самим создать_ComboBox2
25_Программу склада с картинками в Excel VBA самим создать_ComboBox3
26_Программу склада с картинками в Excel VBA самим создать_TextBox1
27_Программу склада с картинками в Excel VBA самим создать_TextBox2-TextBox3
28_Программу склада с картинками в Excel VBA самим создать_Label20
29_Программу склада с картинками в Excel VBA самим создать_Label21- Label22
30_Программу склада с картинками в Excel VBA самим создать_CommandButton3
31_Программу склада с картинками в Excel VBA самим создать_CommandButton4
32_Программу склада с картинками в Excel VBA самим создать_Порядок активации в Frame2
33_Программу склада с картинками в Excel VBA самим создать_Frame3
34_Программу склада с картинками в Excel VBA самим создать_Порядок активации в Frame3
35_Программу склада с картинками в Excel VBA самим создать_CommandButton7
36_Программу склада с картинками в Excel VBA самим создать_CommandButton8
37_Программу склада с картинками в Excel VBA самим создать_ListBox1
38_Программу склада с картинками в Excel VBA самим создать_Tabellenblatt LLLNNN7
39_Программу склада с картинками в Excel VBA самим создать_Ввод кода в Userform1
'''1_1_ LB##########
On Error GoTo EERR
Dim BLATBLAT As Integer
For BLATBLAT = 1 To Worksheets.Count
Worksheets(BLATBLAT).Activate
ActiveWindow.View = xlNormalView
Next BLATBLAT
Worksheets(1).Activate
UserForm1.Show
Exit Sub
EERR:
'''1_1_ LB##########
'''2_1_ LB##########
=СУММ(D3:D758)
'''2_1_ LB##########
'''2_2_ LB##########
=СУММ(E3:E758)
'''2_2_ LB##########
'''3_3_ LB##########
On Error GoTo EERR
Dim SCHO As Long
For SCHO = 1 To 6
ActiveSheet.Cells(1, SCHO).EntireColumn.AutoFit
Next SCHO
Exit Sub
EERR:
'''3_3_ LB##########
'''4_1_ LB#############
Sub CAZUUFAF()
On Error GoTo ERR
TBB1.BackColor = &HC0FFFF
TBB2.BackColor = &HC0FFFF
KuNr.Enabled = True
KuNr.BackColor = &HC0FFFF
Dim IC As String
IC = CoB1
If CoB1 > "" Then
Sheets(IC).Activate
End If
If ActiveSheet.Name <> "Zailer" And ActiveSheet.Name <> "POMO" Then
Dim AAAZ As Variant
Dim AAAC As Variant
POMO.[a2] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
POMO.[a3] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Column
AAAZ = CDbl(POMO.[a2])
AAAC = CDbl(POMO.[a3])
SPALTA1 = ""
SPALTA2 = ""
SPALTA3 = ""
SPALTA4 = ""
SPALTA5 = ""
SPALTA6 = ""
SPALTA7 = ""
SPALTB1 = ""
SPALTB2 = ""
SPALTB3 = ""
SPALTB4 = ""
SPALTB5 = ""
SPALTB6 = ""
SPALTB7 = ""
SPALTC1 = ""
SPALTC2 = ""
SPALTC3 = ""
SPALTC4 = ""
SPALTC5 = ""
SPALTC6 = ""
SPALTC7 = ""
SPALTD1 = ""
SPALTD2 = ""
SPALTD3 = ""
SPALTD4 = ""
SPALTD5 = ""
SPALTD6 = ""
SPALTD7 = ""
SPALTE1 = ""
SPALTE2 = ""
SPALTE3 = ""
SPALTE4 = ""
SPALTE5 = ""
SPALTE6 = ""
SPALTE7 = ""
SPALTF1 = ""
SPALTF2 = ""
SPALTF3 = ""
SPALTF4 = ""
SPALTF5 = ""
SPALTF6 = ""
SPALTF7 = ""
SPALTG1 = ""
SPALTG2 = ""
SPALTG3 = ""
SPALTG4 = ""
SPALTG5 = ""
SPALTG6 = ""
SPALTG7 = ""
SPALTA = ""
SPALTB = ""
SPALTC = ""
SPALTD = ""
SPALTE = ""
SPALTF = ""
SPALTG = ""
KuNr = ""
TBB1.Value = ""
TBB2.Value = ""
TBB3.Value = ""
TBB4.Value = ""
TBB5.Value = ""
TBB6.Value = ""
POMO.[a1] = ""
POMO.[b1] = ""
POMO.[c1] = ""
POMO.[d1] = ""
POMO.[e1] = ""
POMO.[F1] = ""
POMO.[g1] = ""
POMO.[h1] = ""
POMO.[i1] = ""
POMO.[j1] = ""
POMO.[k1] = ""
POMO.[L1] = ""
POMO.[m1] = ""
If POMO.[a2] < 65536 Then
Dim ††† As Variant
If POMO.[a3] = 1 Then
POMO.[a4] = 0
††† = POMO.[a4]
End If
If POMO.[a3] = 7 Then
POMO.[a4] = 6
††† = POMO.[a4]
End If
SPALTA = ActiveSheet.Cells(1, AAAC - †††).Value
SPALTB = ActiveSheet.Cells(1, AAAC + 1).Value
SPALTC = ActiveSheet.Cells(1, AAAC + 2).Value
SPALTD = ActiveSheet.Cells(1, AAAC + 3).Value
SPALTE = ActiveSheet.Cells(1, AAAC + 4).Value
SPALTF = ActiveSheet.Cells(1, AAAC + 5).Value
SPALTG = ActiveSheet.Cells(1, AAAC + 6).Value
If POMO.[a2] > 8 Then
SPALTA1 = ActiveSheet.Cells(AAAZ - 6, AAAC - †††).Value
SPALTB1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 1).Value
SPALTC1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 2).Value
SPALTD1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 3).Value
SPALTE1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 4).Value
SPALTF1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 5).Value
SPALTG1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 6).Value
End If
If POMO.[a2] > 7 Then
SPALTA2 = ActiveSheet.Cells(AAAZ - 5, AAAC - †††).Value
SPALTB2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 1).Value
SPALTC2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 2).Value
SPALTD2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 3).Value
SPALTE2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 4).Value
SPALTF2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 5).Value
SPALTG2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 6).Value
End If
If POMO.[a2] > 6 Then
SPALTA3 = ActiveSheet.Cells(AAAZ - 4, AAAC - †††).Value
SPALTB3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 1).Value
SPALTC3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 2).Value
SPALTD3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 3).Value
SPALTE3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 4).Value
SPALTF3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 5).Value
SPALTG3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 6).Value
End If
If POMO.[a2] > 5 Then
SPALTA4 = ActiveSheet.Cells(AAAZ - 3, AAAC - †††).Value
SPALTB4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 1).Value
SPALTC4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 2).Value
SPALTD4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 3).Value
SPALTE4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 4).Value
SPALTF4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 5).Value
SPALTG4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 6).Value
End If
If POMO.[a2] > 4 Then
SPALTA5 = ActiveSheet.Cells(AAAZ - 2, AAAC - †††).Value
SPALTB5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 1).Value
SPALTC5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 2).Value
SPALTD5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 3).Value
SPALTE5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 4).Value
SPALTF5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 5).Value
SPALTG5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 6).Value
End If
If POMO.[a2] > 3 Then
SPALTA6 = ActiveSheet.Cells(AAAZ - 1, AAAC - †††).Value
SPALTB6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 1).Value
SPALTC6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 2).Value
SPALTD6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 3).Value
SPALTE6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 4).Value
SPALTF6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 5).Value
SPALTG6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 6).Value
End If
If POMO.[a2] > 2 Then
SPALTA7 = ActiveSheet.Cells(AAAZ, AAAC - †††).Value
SPALTB7 = ActiveSheet.Cells(AAAZ, AAAC + 1).Value
SPALTC7 = ActiveSheet.Cells(AAAZ, AAAC + 2).Value
SPALTD7 = ActiveSheet.Cells(AAAZ, AAAC + 3).Value
SPALTE7 = ActiveSheet.Cells(AAAZ, AAAC + 4).Value
SPALTF7 = ActiveSheet.Cells(AAAZ, AAAC + 5).Value
SPALTG7 = ActiveSheet.Cells(AAAZ, AAAC + 6).Value
End If
End If
End If
If ActiveSheet.Name <> "Zailer" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
Private Sub ComboBox1_Change()
On Error GoTo EERR
Dim DDAATT As String
DDAATT = ""
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label9.Caption = ""
Label10.Caption = ""
Label11.Caption = ""
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox1.Value <> "" Then
ComboBox3.Value = ""
ComboBox5.Value = ""
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
Label9.Caption = LLLNNN2.Cells(AAAC, 2)
Label10.Caption = LLLNNN2.Cells(AAAC, 3)
Label11.Caption = Round(LLLNNN2.Cells(AAAC, 6), 2)
Label1.Caption = LLLNNN2.Cells(AAAC, 2)
Label2.Caption = "Bestand: " & LLLNNN2.Cells(AAAC, 4) & " " & LLLNNN2.Cells(AAAC, 3)
Label3.Caption = "Gesamtwert: " & Round(LLLNNN2.Cells(AAAC, 5), 2)
Label4.Caption = "Preis " & "/" & LLLNNN2.Cells(AAAC, 3) & " " & Round(LLLNNN2.Cells(AAAC, 6), 2)
End If
Exit Sub
EERR:
ComboBox1.Value = ""
End Sub
Private Sub ComboBox1_Click()
On Error GoTo EERR
Dim DDAATT As String
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox1.Value <> "" Then
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
If LLLNNN5.Cells(7, AAAR).Value <> "" Then
DDAATT = LLLNNN5.Cells(7, AAAR).Value
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
End If
End If
Exit Sub
EERR:
LLLNNN5.Cells(7, AAAR).Value = ""
End Sub
Private Sub ComboBox2_Change()
On Error GoTo EERR
Label18.Visible = True
TextBox2.Visible = True
If ComboBox2.Value = "Расходы" Or ComboBox2.Value = "Скидки" Then
Label18.Visible = False
TextBox2.Visible = False
TextBox2.Value = ""
End If
If ComboBox2.Value = "Расходы" Or ComboBox2.Value = "Скидки" Or ComboBox2.Value = "Приём" Then
ComboBox4.Value = ""
Exit Sub
Else:
ComboBox2.Value = ""
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox3_Change()
On Error GoTo EERR
Dim DDAATT As String
DDAATT = ""
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label20.Caption = ""
Label21.Caption = ""
Label22.Caption = ""
Call Z2ZZZLB
Exit Sub
EERR:
ComboBox3.Value = ""
End Sub
Private Sub ComboBox3_Click()
On Error GoTo EERR
Dim DDAATT As String
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox3.Value <> "" Then
strSuchen = ComboBox3.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
If LLLNNN5.Cells(7, AAAR).Value <> "" Then
DDAATT = LLLNNN5.Cells(7, AAAR).Value
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
End If
End If
Exit Sub
EERR:
LLLNNN5.Cells(7, AAAR).Value = ""
End Sub
Private Sub ComboBox4_Change()
On Error GoTo EERR
ListBox1.BoundColumn = 8
ListBox1.ColumnCount = 8
ComboBox6.Value = ""
With LLLNNN3
ListBox1.RowSource = .Range(.Cells(11, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 8)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
Dim AAAZ As Long
Dim AAAZ2 As Long
Dim strSuchen As Variant
If ComboBox4.Value <> "" Then
ComboBox2.Value = ""
strSuchen = ComboBox4.Value
AAAZ = CDbl(LLLNNN6.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
LLLNNN4.[e13] = CDbl(ComboBox4.Value)
LLLNNN4.Range("a16:i55") = ""
ComboBox6.Clear
Dim SCHOT As Long
Dim AAAC As Long
Dim SCHOT2
For SCHOT = 0 To 39
AAAC = 2 + SCHOT * 9
If LLLNNN6.Cells(AAAZ, AAAC).Value <> "" Then
AAAZ2 = CDbl(LLLNNN4.Cells(Rows.Count, 1).End(xlUp).Row) + 1
For SCHOT2 = 1 To 9
LLLNNN4.Cells(AAAZ2, SCHOT2).Value = LLLNNN6.Cells(AAAZ, AAAC + SCHOT2 - 1).Value
Next SCHOT2
With ComboBox6
.AddItem LLLNNN6.Cells(AAAZ, AAAC).Value
End With
End If
Next SCHOT
ListBox1.BoundColumn = 9
ListBox1.ColumnCount = 9
With LLLNNN4
ListBox1.RowSource = .Range(.Cells(16, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 9)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
End If
Exit Sub
EERR:
ComboBox4.Value = ""
End Sub
Private Sub ComboBox4_DropButtonClick()
On Error GoTo EERR
LLLNNN6.[a2] = 1
Dim AAAZ As Long
AAAZ = CDbl(LLLNNN6.Cells(Rows.Count, 1).End(xlUp).Row)
If LLLNNN6.Cells(AAAZ, 2) <> "" Then
LLLNNN6.Cells(AAAZ + 1, 1) = LLLNNN6.Cells(AAAZ, 1) + 1
End If
With LLLNNN6
ComboBox4.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Exit Sub
EERR:
End Sub
Private Sub ComboBox5_Change()
On Error GoTo EERR
Dim DDAATT As String
DDAATT = ""
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label31.Caption = ""
Label32.Caption = ""
Label33.Caption = ""
TextBox5.Value = ""
Label34.Caption = ""
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox5.Value <> "" Then
ComboBox1.Value = ""
ComboBox3.Value = ""
strSuchen = ComboBox5.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
Label31.Caption = LLLNNN2.Cells(AAAC, 2)
Label32.Caption = LLLNNN2.Cells(AAAC, 3)
Label33.Caption = Round(LLLNNN2.Cells(AAAC, 6), 2)
Label1.Caption = LLLNNN2.Cells(AAAC, 2)
Label2.Caption = "Bestand: " & LLLNNN2.Cells(AAAC, 4) & " " & LLLNNN2.Cells(AAAC, 3)
Label3.Caption = "Gesamtwert: " & Round(LLLNNN2.Cells(AAAC, 5), 2)
Label4.Caption = "Preis " & "/" & LLLNNN2.Cells(AAAC, 3) & " " & Round(LLLNNN2.Cells(AAAC, 6), 2)
End If
Exit Sub
EERR:
ComboBox5.Value = ""
End Sub
Private Sub ComboBox5_Click()
On Error GoTo EERR
Dim DDAATT As String
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox5.Value <> "" Then
strSuchen = ComboBox5.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
If LLLNNN5.Cells(7, AAAR).Value <> "" Then
DDAATT = LLLNNN5.Cells(7, AAAR).Value
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
End If
End If
Exit Sub
EERR:
LLLNNN5.Cells(7, AAAR).Value = ""
End Sub
Private Sub ComboBox6_Change()
On Error GoTo EERR
ComboBox5.Value = ""
Label31.Caption = ""
Label32.Caption = ""
Label33.Caption = ""
TextBox5.Value = ""
Label34.Caption = ""
If ComboBox4.Value = "" Then
ComboBox6.Value = ""
End If
If ComboBox6.Value <> "" Then
If CDbl(ComboBox6.Value) < 1 Or CDbl(ComboBox6.Value) > 40 Then
MsgBox " Номер позиции должен быть не менее 1 и не более 40!", 48, "www.excel.npage.de "
ComboBox6.Value = ""
End If
ComboBox6.Value = Round(CDbl(ComboBox6.Value) * 1, 0)
Dim AAAZ As Long
Dim ZAAA As Long
Dim AAAC As Long
Dim strSuchen As Variant
strSuchen = CDbl(ComboBox4.Value)
AAAZ = CDbl(LLLNNN6.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
ZAAA = CDbl(ComboBox6.Value)
AAAC = 2 + (ZAAA - 1) * 9
ComboBox5.Value = LLLNNN6.Cells(AAAZ, AAAC + 2).Value
Label31.Caption = LLLNNN6.Cells(AAAZ, AAAC + 3).Value
Label32.Caption = LLLNNN6.Cells(AAAZ, AAAC + 4).Value
Label33.Caption = LLLNNN6.Cells(AAAZ, AAAC + 5).Value
End If
Exit Sub
EERR:
ComboBox6.Value = ""
End Sub
Private Sub CommandButton1_Click()
On Error GoTo EERR
If ComboBox1.Value = "" Then
MsgBox "Номер артикля не выбран!", 48, "www.excel.npage.de "
ComboBox1.SetFocus
Exit Sub
End If
Dim ††† As String
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
††† = Application.GetOpenFilename(, , "Bild auswählen www.excel.npage.de", , False)
Select Case Right(†††, 3)
Case "ani", "apng", "bmp", "cht", "cur", "gif", "ico", "jpg", "jpeg", "kml", "png", "rgb", "svg", "svgz", "tif", "tiff", "xbm", "xpm", "JPG", "ANI", "APNG", "BMP", "CHT", "CUR", "GIF", "ICO", "JPEG", "KML", "PNG", "RGB", "SVG", "SVGZ", "TIF", "TIFF", "XBM", "XPM"
Case Else
MsgBox "Вы не выбрали картинку!", 48, "www.excel.npage.de "
End Select
Image1.Picture = LoadPicture(†††)
Image2.Picture = LoadPicture(†††)
If ComboBox1.Value <> "" Then
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
LLLNNN5.Cells(7, AAAR).Value = †††
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton2_Click()
On Error GoTo EERR
If ComboBox1.Value = "" Then
MsgBox "Номер артикля не выбран!", 48, "www.excel.npage.de "
ComboBox1.SetFocus
Exit Sub
End If
Unload Me
Dim DDNN As Variant
DDNN = Application.InputBox("Пароль:", "www.excel.npage.de Удалить картинку")
If DDNN <> 3 Then
MsgBox "Пароль неправильный!", , "www.excel.npage.de Удалить картинку "
Exit Sub
Else
End If
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox1.Value <> "" Then
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
LLLNNN5.Cells(7, AAAR).Value = ""
End If
MsgBox "Артикль не имеет картинку!", 48, "www.excel.npage.de "
Exit Sub
EERR:
End Sub
Private Sub CommandButton3_Click()
On Error GoTo EERR
If ComboBox2 = "Приём" Then
TextBox2.SetFocus
End If
TextBox3.SetFocus
ComboBox2.SetFocus
If LLLNNN3.[a100000] <> "" Then
MsgBox "Журнал заполнен!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox "Документ не внесён!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox2.Value = "" Then
MsgBox "Вид операции не выбран!", 48, "www.excel.npage.de "
ComboBox2.SetFocus
Exit Sub
End If
If ComboBox3.Value = "" Then
MsgBox "Номер артикля не выбран!", 48, "www.excel.npage.de "
ComboBox3.SetFocus
Exit Sub
End If
Dim ††† As Long
Dim AAAR As Long
Dim †††2 As Long
Dim strSuchen As Variant
LLLNNN3.[a11] = 0
††† = CDbl(LLLNNN3.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLNNN3.Cells(†††, 1) = LLLNNN3.Cells(††† - 1, 1) + 1
LLLNNN3.Cells(†††, 1).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 2) = Date
LLLNNN3.Cells(†††, 2) = Format(Date, "dd.mm.yyyy")
LLLNNN3.Cells(†††, 2).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 3) = TextBox1.Value
LLLNNN3.Cells(†††, 3).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 4) = ComboBox3.Value
LLLNNN3.Cells(†††, 4).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 5) = Label20.Caption
LLLNNN3.Cells(†††, 5).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 6) = Label21.Caption
LLLNNN3.Cells(†††, 6).HorizontalAlignment = xlCenter
If ComboBox2 = "Приём" Then
LLLNNN3.Cells(†††, 7) = CDbl(TextBox2.Value)
LLLNNN3.Cells(†††, 7).HorizontalAlignment = xlCenter
End If
If ComboBox2 = "Приём" Or ComboBox2 = "Расходы" Then
LLLNNN3.Cells(†††, 8) = Round(CDbl(TextBox3.Value), 2)
Else:
LLLNNN3.Cells(†††, 8) = Round(CDbl(TextBox3.Value), 2) * -1
End If
LLLNNN3.Cells(†††, 8).HorizontalAlignment = xlCenter
strSuchen = ComboBox3.Value
†††2 = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (†††2 - 3) * 5
LLLNNN5.Cells(†††, AAAR) = LLLNNN3.Cells(†††, 1)
LLLNNN5.Cells(†††, AAAR).HorizontalAlignment = xlCenter
LLLNNN5.Cells(†††, AAAR + 1) = LLLNNN3.Cells(†††, 2)
LLLNNN5.Cells(†††, AAAR + 1) = Format(Date, "dd.mm.yyyy")
LLLNNN5.Cells(†††, AAAR + 1).HorizontalAlignment = xlCenter
LLLNNN5.Cells(†††, AAAR + 2) = LLLNNN3.Cells(†††, 3)
LLLNNN5.Cells(†††, AAAR + 2).HorizontalAlignment = xlCenter
LLLNNN5.Cells(†††, AAAR + 3) = LLLNNN3.Cells(†††, 7)
LLLNNN5.Cells(†††, AAAR + 3).HorizontalAlignment = xlCenter
LLLNNN5.Cells(†††, AAAR + 4) = LLLNNN3.Cells(†††, 8)
LLLNNN5.Cells(†††, AAAR + 4).HorizontalAlignment = xlCenter
LLLNNN5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLNNN5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLNNN5.Cells(4, AAAR + 3) = LLLNNN5.Cells(4, AAAR + 3).Value
LLLNNN5.Cells(5, AAAR + 4) = LLLNNN5.Cells(5, AAAR + 4).Value
If LLLNNN5.Cells(4, AAAR + 3) > 0 Then
LLLNNN5.Cells(6, AAAR) = Round(LLLNNN5.Cells(5, AAAR + 4) / LLLNNN5.Cells(4, AAAR + 3), 2)
Else:
LLLNNN5.Cells(6, AAAR) = 0
End If
Call Z3ZZZLB
With LLLNNN3
ListBox1.RowSource = .Range(.Cells(11, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 8)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
Call Z2ZZZLB
TextBox2.Value = ""
TextBox3.Value = ""
Exit Sub
EERR:
End Sub
Private Sub CommandButton4_Click()
On Error GoTo EERR
If ComboBox3.Value = "" Then
MsgBox "Номер артикля не выбран!", 48, "www.excel.npage.de "
ComboBox3.SetFocus
Exit Sub
End If
Dim strSuchen As Variant
Dim SCHOT As Long
Dim AAAC As Long
Dim AAAC2 As Long
Dim AAAZ As Long
If ComboBox3 <> "" Then
LLLNNN7.Range("a1:f65530") = ""
strSuchen = ComboBox3.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAC2 = 2 + (AAAC - 3) * 5
For SCHOT = 1 To 6
LLLNNN7.Cells(SCHOT + 1, 1) = LLLNNN2.Cells(2, SCHOT)
Next SCHOT
LLLNNN7.Cells(2, 4) = LLLNNN2.Cells(AAAC, 1)
LLLNNN7.Cells(3, 4) = LLLNNN2.Cells(AAAC, 2)
LLLNNN7.Cells(4, 4) = LLLNNN2.Cells(AAAC, 3)
LLLNNN7.Cells(5, 4) = LLLNNN5.Cells(4, AAAC2 + 3)
LLLNNN7.Cells(6, 5) = LLLNNN5.Cells(5, AAAC2 + 4)
LLLNNN7.Cells(7, 4) = LLLNNN5.Cells(6, AAAC2)
For SCHOT = 1 To 5
LLLNNN7.Cells(9, SCHOT) = LLLNNN5.Cells(11, SCHOT - 1 + AAAC2)
Next SCHOT
For SCHOT = 1 To 100000
If LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2) <> "" Then
AAAZ = CDbl(LLLNNN7.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLNNN7.Cells(AAAZ, 1) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2)
LLLNNN7.Cells(AAAZ, 2) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2 + 1)
LLLNNN7.Cells(AAAZ, 3) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2 + 2)
LLLNNN7.Cells(AAAZ, 4) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2 + 3)
LLLNNN7.Cells(AAAZ, 5) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2 + 4)
End If
Next SCHOT
LLLNNN7.Name = "№._" & LLLNNN7.[d2]
LLLNNN7.Activate
Dim DDAATT As String
Dim ZZEELL As Range
Dim SCAAL As Double
LLLNNN7.[d1].Select
ActiveSheet.Columns("d:d").ColumnWidth = 22.14
ActiveSheet.Rows("1:1").RowHeight = 62.25
Dim SEGG
For Each SEGG In ActiveSheet.Shapes
If Not Intersect(SEGG.TopLeftCell, ActiveCell) Is Nothing Then SEGG.Delete
Next SEGG
Set ZZEELL = ActiveCell
DDAATT = LLLNNN5.Cells(7, AAAC2)
Select Case Right(DDAATT, 3)
Case "ani", "apng", "bmp", "cht", "cur", "gif", "ico", "jpg", "jpeg", "kml", "png", "rgb", "svg", "svgz", "tif", "tiff", "xbm", "xpm", "JPG", "ANI", "APNG", "BMP", "CHT", "CUR", "GIF", "ICO", "JPEG", "KML", "PNG", "RGB", "SVG", "SVGZ", "TIF", "TIFF", "XBM", "XPM"
ActiveSheet.Pictures.Insert(DDAATT).Select
With Selection.ShapeRange
.Top = ZZEELL.Top
.Left = ZZEELL.Left
SCAAL = WorksheetFunction.Min(ZZEELL.Width / .Width, ZZEELL.Height / .Height)
.Height = .Height * SCAAL
End With
Selection.Placement = xlMoveAndSize
Selection.PrintObject = True
Case Else
MsgBox "Артикль не имеет картинку!", 48, "www.excel.npage.de "
End Select
LLLNNN7.[d2].Select
ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 2).ColumnWidth = 20
ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit
With ActiveSheet.PageSetup
.RightHeader = ActiveSheet.Name & ": &P/&N"
End With
LLLNNN7.Activate
UserForm1.Hide
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton5_Click()
On Error GoTo EERR
If LLLNNN3.[a10000] <> "" Then
MsgBox "Журнал заполнен!!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox4 = "" Then
MsgBox "Накладная выхода артиклей не выбрана!", 48, "www.excel.npage.de "
ComboBox4.SetFocus
Exit Sub
End If
If ComboBox6 = "" Then
MsgBox " Позиция не выбрана!", 48, "www.excel.npage.de "
ComboBox6.SetFocus
Exit Sub
End If
If ComboBox5 = "" Then
MsgBox "Номер артикля не выбран!", 48, "www.excel.npage.de "
ComboBox5.SetFocus
Exit Sub
End If
If TextBox5 = "" Then
MsgBox "Количество не указано!", 48, "www.excel.npage.de "
TextBox5.SetFocus
Exit Sub
End If
Dim AAAZ As Long
Dim AAAC As Long
Dim ZAAA As Long
Dim strSuchen As Variant
strSuchen = ComboBox4.Value
AAAZ = CDbl(LLLNNN6.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
ZAAA = CDbl(ComboBox6.Value)
AAAC = 2 + (ZAAA - 1) * 9
LLLNNN6.Cells(AAAZ, AAAC) = CDbl(ComboBox6.Value)
LLLNNN6.Cells(AAAZ, AAAC + 1) = Date
LLLNNN6.Cells(AAAZ, AAAC + 2) = ComboBox5.Value
LLLNNN6.Cells(AAAZ, AAAC + 3) = Label31.Caption
LLLNNN6.Cells(AAAZ, AAAC + 4) = Label32.Caption
LLLNNN6.Cells(AAAZ, AAAC + 5) = CDbl(Label33.Caption)
LLLNNN6.Cells(AAAZ, AAAC + 6) = CDbl(TextBox5.Value)
LLLNNN6.Cells(AAAZ, AAAC + 7) = CDbl(Label34.Caption)
Dim AAAZ2 As Long
Dim AAAZ3 As Long
Dim AAAR As Long
If LLLNNN6.Cells(AAAZ, AAAC + 8) <> "" Then
AAAZ2 = LLLNNN6.Cells(AAAZ, AAAC + 8) + 11
AAAZ3 = CDbl(LLLNNN2.Range("a3:a758").Find(What:=LLLNNN3.Cells(AAAZ2, 4), lookat:=xlWhole).Row)
AAAR = 2 + (AAAZ3 - 3) * 5
LLLNNN5.Cells(AAAZ2, AAAR) = ""
LLLNNN5.Cells(AAAZ2, AAAR + 1) = ""
LLLNNN5.Cells(AAAZ2, AAAR + 2) = ""
LLLNNN5.Cells(AAAZ2, AAAR + 3) = ""
LLLNNN5.Cells(AAAZ2, AAAR + 4) = ""
LLLNNN5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLNNN5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLNNN5.Cells(4, AAAR + 3) = LLLNNN5.Cells(4, AAAR + 3).Value
LLLNNN5.Cells(5, AAAR + 4) = LLLNNN5.Cells(5, AAAR + 4).Value
If LLLNNN5.Cells(4, AAAR + 3) > 0 Then
LLLNNN5.Cells(6, AAAR) = Round(LLLNNN5.Cells(5, AAAR + 4) / LLLNNN5.Cells(4, AAAR + 3), 2)
Else:
LLLNNN5.Cells(6, AAAR) = 0
End If
LLLNNN3.Cells(AAAZ2, 1) = ""
LLLNNN3.Cells(AAAZ2, 2) = ""
LLLNNN3.Cells(AAAZ2, 3) = ""
LLLNNN3.Cells(AAAZ2, 4) = ""
LLLNNN3.Cells(AAAZ2, 5) = ""
LLLNNN3.Cells(AAAZ2, 6) = ""
LLLNNN3.Cells(AAAZ2, 7) = ""
LLLNNN3.Cells(AAAZ2, 8) = ""
LLLNNN5.Cells(AAAZ2, 3782) = ""
LLLNNN5.Cells(AAAZ2, 3783) = ""
LLLNNN6.Cells(AAAZ, AAAC + 8) = ""
End If
If LLLNNN6.Cells(AAAZ, AAAC + 8) = "" Then
AAAZ2 = CDbl(LLLNNN3.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLNNN6.Cells(AAAZ, AAAC + 8) = AAAZ2
LLLNNN3.Cells(AAAZ2, 1) = LLLNNN3.Cells(AAAZ2 - 1, 1) + 1
LLLNNN3.Cells(AAAZ2, 1).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 2) = LLLNNN6.Cells(AAAZ, AAAC)
LLLNNN3.Cells(AAAZ2, 2) = Format(Date, "dd.mm.yyyy")
LLLNNN3.Cells(AAAZ2, 2).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 3) = "Ent.Sch." & ComboBox4.Value & "/" & ComboBox6.Value
LLLNNN3.Cells(AAAZ2, 3).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 4) = LLLNNN6.Cells(AAAZ, AAAC + 2)
LLLNNN3.Cells(AAAZ2, 4).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 5) = LLLNNN6.Cells(AAAZ, AAAC + 3)
LLLNNN3.Cells(AAAZ2, 5).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 6) = LLLNNN6.Cells(AAAZ, AAAC + 4)
LLLNNN3.Cells(AAAZ2, 6).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 7) = LLLNNN6.Cells(AAAZ, AAAC + 6) * -1
LLLNNN3.Cells(AAAZ2, 7).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 8) = LLLNNN6.Cells(AAAZ, AAAC + 7) * -1
LLLNNN3.Cells(AAAZ2, 8).HorizontalAlignment = xlCenter
AAAZ3 = CDbl(LLLNNN2.Range("a3:a758").Find(What:=ComboBox5.Value, lookat:=xlWhole).Row)
AAAR = 2 + (AAAZ3 - 3) * 5
LLLNNN5.Cells(AAAZ2, AAAR) = LLLNNN3.Cells(AAAZ2, 1)
LLLNNN5.Cells(AAAZ2, AAAR).HorizontalAlignment = xlCenter
LLLNNN5.Cells(AAAZ2, AAAR + 1) = LLLNNN3.Cells(AAAZ2, 2)
LLLNNN5.Cells(AAAZ2, AAAR + 1) = Format(Date, "dd.mm.yyyy")
LLLNNN5.Cells(AAAZ2, AAAR + 1).HorizontalAlignment = xlCenter
LLLNNN5.Cells(AAAZ2, AAAR + 2) = LLLNNN3.Cells(AAAZ2, 3)
LLLNNN5.Cells(AAAZ2, AAAR + 2).HorizontalAlignment = xlCenter
LLLNNN5.Cells(AAAZ2, AAAR + 3) = LLLNNN3.Cells(AAAZ2, 7)
LLLNNN5.Cells(AAAZ2, AAAR + 3).HorizontalAlignment = xlCenter
LLLNNN5.Cells(AAAZ2, AAAR + 4) = LLLNNN3.Cells(AAAZ2, 8)
LLLNNN5.Cells(AAAZ2, AAAR + 4).HorizontalAlignment = xlCenter
LLLNNN5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLNNN5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLNNN5.Cells(4, AAAR + 3) = LLLNNN5.Cells(4, AAAR + 3).Value
LLLNNN5.Cells(5, AAAR + 4) = LLLNNN5.Cells(5, AAAR + 4).Value
If LLLNNN5.Cells(4, AAAR + 3) > 0 Then
LLLNNN5.Cells(6, AAAR) = Round(LLLNNN5.Cells(5, AAAR + 4) / LLLNNN5.Cells(4, AAAR + 3), 2)
Else:
LLLNNN5.Cells(6, AAAR) = 0
End If
LLLNNN5.Cells(AAAZ2, 3782) = CDbl(ComboBox4.Value)
LLLNNN5.Cells(AAAZ2, 3783) = CDbl(ComboBox6.Value)
LLLNNN6.Cells(AAAZ, AAAC + 8) = LLLNNN3.Cells(AAAZ2, 1)
End If
Call Z3ZZZLB
Label24.Caption = ComboBox6.Value
Label25.Caption = ComboBox5.Value
Call ComboBox4_Change
ComboBox6.Value = "_"
ComboBox6.Value = Label24.Caption
Label24.Caption = "Position"
ComboBox5.Value = Label25.Caption
Label25.Caption = "Artikel-Nr."
TextBox5.Value = ""
ComboBox6.SetFocus
Exit Sub
EERR:
End Sub
Private Sub CommandButton6_Click()
On Error GoTo EERR
If ComboBox4.Value <> "" Then
LLLNNN4.Activate
LLLNNN4.[e13].Select
Dim SHOT As Long
For SHOT = 1 To 8
ActiveSheet.Cells(Rows.Count, SHOT).EntireColumn.AutoFit
Next SHOT
With ActiveSheet.PageSetup
.RightHeader = ActiveSheet.Name & ActiveSheet.[e13] & ": &P/&N"
End With
LLLNNN4.Activate
UserForm1.Hide
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton7_Click()
On Error GoTo EERR
LLLNNN3.Activate
Unload Me
Dim AAAA As Variant
Dim strSuchen As Variant
Dim strFrage As Double
AAAA = MsgBox("" & " Вы действительно хотите удалить запись?" & "", vbYesNo, "www.excel.npage.de Удалить")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox("Пароль:", "www.excel.npage.de Удалить")
If strSuchen <> 3 Then
AAAA = MsgBox("Пароль неверен !", , "www.excel.npage.de Удалить")
Exit Sub
Else
End If
strSuchen = Application.InputBox("Введите желаемый Ид.-№. ", "www.excel.npage.de Удалить")
If strSuchen = False Then
AAAA = MsgBox("Этот Ид.-№. не существует!", , "www.excel.npage.de Удалить")
Exit Sub
End If
If strSuchen = 0 Then
AAAA = MsgBox("Этот Ид.-№. (0) не существует!", , "www.excel.npage.de Удалить")
Exit Sub
End If
If strSuchen = "" Then
AAAA = MsgBox("Введите Ид.-№.!", , "www.excel.npage.de Удалить")
Exit Sub
End If
If strSuchen = False Then
Exit Sub
Else
ActiveSheet.Range("a11:a65530").Cells.Find(What:=strSuchen, lookat:=xlWhole).Activate
strFrage = MsgBox("Хотите эту запись: " & "Ид.-№.-" & ActiveCell.Value & "; " & "Дата-" & ActiveCell.Offset(0, 1) & "; " & "Документ-" & ActiveCell.Offset(0, 2) & "; " & " удалить?", vbYesNo, "www.excel.npage.de Удалить")
If strFrage = vbNo Then
Exit Sub
ElseIf strFrage = vbYes Then
Dim AAAZ As Long
Dim AAAZ2 As Long
Dim AAAR As Long
AAAZ = CDbl(ActiveCell.Row)
AAAZ2 = CDbl(LLLNNN2.Range("a3:a758").Find(What:=LLLNNN3.Cells(AAAZ, 4), lookat:=xlWhole).Row)
AAAR = 2 + (AAAZ2 - 3) * 5
Dim SHHOT As Long
For SHHOT = 1 To 8
ActiveSheet.Cells(AAAZ, SHHOT) = ""
Next SHHOT
LLLNNN5.Cells(AAAZ, AAAR) = ""
LLLNNN5.Cells(AAAZ, AAAR + 1) = ""
LLLNNN5.Cells(AAAZ, AAAR + 2) = ""
LLLNNN5.Cells(AAAZ, AAAR + 3) = ""
LLLNNN5.Cells(AAAZ, AAAR + 4) = ""
LLLNNN5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLNNN5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLNNN5.Cells(4, AAAR + 3) = LLLNNN5.Cells(4, AAAR + 3).Value
LLLNNN5.Cells(5, AAAR + 4) = LLLNNN5.Cells(5, AAAR + 4).Value
If LLLNNN5.Cells(4, AAAR + 3) > 0 Then
LLLNNN5.Cells(6, AAAR) = Round(LLLNNN5.Cells(5, AAAR + 4) / LLLNNN5.Cells(4, AAAR + 3), 2)
Else:
LLLNNN5.Cells(6, AAAR) = 0
End If
If LLLNNN5.Cells(AAAZ, 3782) <> "" Then
Dim AAAC As Long
AAAR = LLLNNN5.Cells(AAAZ, 3782) + 1
SHHOT = LLLNNN5.Cells(AAAZ, 3783)
AAAC = 2 + (SHHOT - 1) * 9
For AAAZ2 = 0 To 8
LLLNNN6.Cells(AAAR, AAAC + AAAZ2) = ""
Next AAAZ2
LLLNNN5.Cells(AAAZ, 3782) = ""
LLLNNN5.Cells(AAAZ, 3783) = ""
End If
AAAA = MsgBox("Этот Ид.-№. не существует!", , "www.excel.npage.de Удалить")
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3) <> LLLNNN2.Cells(SCHOT, 4) Then
LLLNNN2.Cells(SCHOT, 4) = LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3)
End If
If LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4) <> LLLNNN2.Cells(SCHOT, 5) Then
LLLNNN2.Cells(SCHOT, 5) = LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4)
End If
If LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5)) <> LLLNNN2.Cells(SCHOT, 6) Then
LLLNNN2.Cells(SCHOT, 6) = LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5))
End If
Next SCHOT
End If
End If
LLLNNN1.Activate
Exit Sub
EERR:
LLLNNN1.Activate
AAAA = MsgBox("Этот Ид.-№. не существует!", , "www.excel.npage.de Удалить")
End Sub
Sub COMUUFAF()
On Error GoTo ERR
TBB1.BackColor = &HC0FFFF
TBB2.BackColor = &HC0FFFF
KuNr.Enabled = True
KuNr.BackColor = &HC0FFFF
Dim IC As String
IC = CoB1
If CoB1 > "" Then
Sheets(IC).Activate
End If
If ActiveSheet.Name <> "Zailer" And ActiveSheet.Name <> "POMO" Then
Dim AAAZ As Variant
Dim AAAC As Variant
POMO.[a2] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
POMO.[a3] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Column
AAAZ = CDbl(POMO.[a2])
AAAC = CDbl(POMO.[a3])
SPALTA1 = ""
SPALTA2 = ""
SPALTA3 = ""
SPALTA4 = ""
SPALTA5 = ""
SPALTA6 = ""
SPALTA7 = ""
SPALTB1 = ""
SPALTB2 = ""
SPALTB3 = ""
SPALTB4 = ""
SPALTB5 = ""
SPALTB6 = ""
SPALTB7 = ""
SPALTC1 = ""
SPALTC2 = ""
SPALTC3 = ""
SPALTC4 = ""
SPALTC5 = ""
SPALTC6 = ""
SPALTC7 = ""
SPALTD1 = ""
SPALTD2 = ""
SPALTD3 = ""
SPALTD4 = ""
SPALTD5 = ""
SPALTD6 = ""
SPALTD7 = ""
SPALTE1 = ""
SPALTE2 = ""
SPALTE3 = ""
SPALTE4 = ""
SPALTE5 = ""
SPALTE6 = ""
SPALTE7 = ""
SPALTF1 = ""
SPALTF2 = ""
SPALTF3 = ""
SPALTF4 = ""
SPALTF5 = ""
SPALTF6 = ""
SPALTF7 = ""
SPALTG1 = ""
SPALTG2 = ""
SPALTG3 = ""
SPALTG4 = ""
SPALTG5 = ""
SPALTG6 = ""
SPALTG7 = ""
SPALTA = ""
SPALTB = ""
SPALTC = ""
SPALTD = ""
SPALTE = ""
SPALTF = ""
SPALTG = ""
KuNr = ""
TBB1.Value = ""
TBB2.Value = ""
TBB3.Value = ""
TBB4.Value = ""
TBB5.Value = ""
TBB6.Value = ""
POMO.[a1] = ""
POMO.[b1] = ""
POMO.[c1] = ""
POMO.[d1] = ""
POMO.[e1] = ""
POMO.[F1] = ""
POMO.[g1] = ""
POMO.[h1] = ""
POMO.[i1] = ""
POMO.[j1] = ""
POMO.[k1] = ""
POMO.[L1] = ""
POMO.[m1] = ""
If POMO.[a2] < 65536 Then
Dim ††† As Variant
If POMO.[a3] = 1 Then
POMO.[a4] = 0
††† = POMO.[a4]
End If
If POMO.[a3] = 7 Then
POMO.[a4] = 6
††† = POMO.[a4]
End If
SPALTA = ActiveSheet.Cells(1, AAAC - †††).Value
SPALTB = ActiveSheet.Cells(1, AAAC + 1).Value
SPALTC = ActiveSheet.Cells(1, AAAC + 2).Value
SPALTD = ActiveSheet.Cells(1, AAAC + 3).Value
SPALTE = ActiveSheet.Cells(1, AAAC + 4).Value
SPALTF = ActiveSheet.Cells(1, AAAC + 5).Value
SPALTG = ActiveSheet.Cells(1, AAAC + 6).Value
If POMO.[a2] > 8 Then
SPALTA1 = ActiveSheet.Cells(AAAZ - 6, AAAC - †††).Value
SPALTB1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 1).Value
SPALTC1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 2).Value
SPALTD1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 3).Value
SPALTE1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 4).Value
SPALTF1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 5).Value
SPALTG1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 6).Value
End If
If POMO.[a2] > 7 Then
SPALTA2 = ActiveSheet.Cells(AAAZ - 5, AAAC - †††).Value
SPALTB2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 1).Value
SPALTC2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 2).Value
SPALTD2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 3).Value
SPALTE2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 4).Value
SPALTF2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 5).Value
SPALTG2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 6).Value
End If
If POMO.[a2] > 6 Then
SPALTA3 = ActiveSheet.Cells(AAAZ - 4, AAAC - †††).Value
SPALTB3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 1).Value
SPALTC3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 2).Value
SPALTD3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 3).Value
SPALTE3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 4).Value
SPALTF3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 5).Value
SPALTG3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 6).Value
End If
If POMO.[a2] > 5 Then
SPALTA4 = ActiveSheet.Cells(AAAZ - 3, AAAC - †††).Value
SPALTB4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 1).Value
SPALTC4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 2).Value
SPALTD4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 3).Value
SPALTE4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 4).Value
SPALTF4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 5).Value
SPALTG4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 6).Value
End If
If POMO.[a2] > 4 Then
SPALTA5 = ActiveSheet.Cells(AAAZ - 2, AAAC - †††).Value
SPALTB5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 1).Value
SPALTC5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 2).Value
SPALTD5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 3).Value
SPALTE5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 4).Value
SPALTF5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 5).Value
SPALTG5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 6).Value
End If
If POMO.[a2] > 3 Then
SPALTA6 = ActiveSheet.Cells(AAAZ - 1, AAAC - †††).Value
SPALTB6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 1).Value
SPALTC6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 2).Value
SPALTD6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 3).Value
SPALTE6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 4).Value
SPALTF6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 5).Value
SPALTG6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 6).Value
End If
If POMO.[a2] > 2 Then
SPALTA7 = ActiveSheet.Cells(AAAZ, AAAC - †††).Value
SPALTB7 = ActiveSheet.Cells(AAAZ, AAAC + 1).Value
SPALTC7 = ActiveSheet.Cells(AAAZ, AAAC + 2).Value
SPALTD7 = ActiveSheet.Cells(AAAZ, AAAC + 3).Value
SPALTE7 = ActiveSheet.Cells(AAAZ, AAAC + 4).Value
SPALTF7 = ActiveSheet.Cells(AAAZ, AAAC + 5).Value
SPALTG7 = ActiveSheet.Cells(AAAZ, AAAC + 6).Value
End If
End If
End If
If ActiveSheet.Name <> "Zailer" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
Private Sub CommandButton8_Click()
On Error GoTo EERR
Unload Me
Dim AAAA As Variant
AAAA = MsgBox("" & " Вы действительно хотите удалить все записи?" & " " & "", vbYesNo, "www.excel.npage.de Удалить")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox("Пароль:", "www.excel.npage.de Удалить")
If strSuchen <> 3 Then
AAAA = MsgBox("Пароль неверен!", , "www.excel.npage.de Удалить")
Exit Sub
Else
End If
LLLNNN3.Range("a12:h100000") = ""
LLLNNN5.Range("b12:eom100000") = ""
LLLNNN5.Range("b4:eom6") = ""
LLLNNN6.Range("a2:mw100000") = ""
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3) <> LLLNNN2.Cells(SCHOT, 4) Then
LLLNNN2.Cells(SCHOT, 4) = LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3)
End If
If LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4) <> LLLNNN2.Cells(SCHOT, 5) Then
LLLNNN2.Cells(SCHOT, 5) = LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4)
End If
If LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5)) <> LLLNNN2.Cells(SCHOT, 6) Then
LLLNNN2.Cells(SCHOT, 6) = LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5))
End If
Next SCHOT
MsgBox " Всё удалено! ", 48, "www.excel.npage.de "
EERR:
End Sub
Sub teerch()
On Error GoTo EERR
If LLLNNN1.Cells(1961, 1962) <> Date Then
LLLNNN1.Cells(1961, 1962) = Date
ActiveWorkbook.FollowHyperlink Address:="https://youtu.be/xPjiMeZ1ASc", NewWindow:=True
End If
Exit Sub
EERR:
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
TextBox2.Value = CDbl(TextBox2.Value) * 1
Exit Sub
EERR:
TextBox2.Value = 0
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
TextBox3.Value = CDbl(TextBox3.Value) * 1
Exit Sub
EERR:
TextBox3.Value = 0
End Sub
Private Sub TextBox5_Change()
On Error GoTo EERR
Label34.Caption = ""
If TextBox5.Value <> "" Then
If ComboBox5 = "" Then
MsgBox "Номер артикля не выбран!", 48, "www.excel.npage.de "
ComboBox5.SetFocus
Exit Sub
End If
Label34.Caption = Round(CDbl(TextBox5.Value) * CDbl(Label33.Caption), 2)
Dim AAAZ As Long
AAAZ = CDbl(LLLNNN2.Range("a3:a758").Find(What:=ComboBox5.Value, lookat:=xlWhole).Row)
If CDbl(TextBox5.Value) > LLLNNN2.Cells(AAAZ, 4) Then
MsgBox " Количество больше общего запаса!", 48, "www.excel.npage.de "
TextBox5.Value = ""
TextBox5.SetFocus
Exit Sub
End If
End If
Exit Sub
EERR:
TextBox5.Value = ""
End Sub
Private Sub UserForm_Initialize()
On Error GoTo EERR
Call ZZUUFF
LLLNNN3.[a11] = 0
With UserForm1
.Height = 431
.Width = 600
End With
Call Z1ZZZLB
With LLLNNN2
ComboBox1.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ComboBox2.Clear
With ComboBox2
.AddItem "Приём"
.AddItem "Расходы"
.AddItem "Скидки"
End With
With LLLNNN2
ComboBox3.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Call Z3ZZZLB
Call teerch
With LLLNNN6
ComboBox4.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With LLLNNN2
ComboBox5.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Exit Sub
EERR:
End Sub
Sub Z1ZZZLB()
With LLLNNN3
ListBox1.RowSource = .Range(.Cells(11, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 8)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
End Sub
Sub Z2ZZZLB()
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox3.Value <> "" Then
ComboBox1.Value = ""
ComboBox5.Value = ""
strSuchen = ComboBox3.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
Label20.Caption = LLLNNN2.Cells(AAAC, 2)
Label21.Caption = LLLNNN2.Cells(AAAC, 3)
Label22.Caption = Round(LLLNNN2.Cells(AAAC, 6), 2)
Label1.Caption = LLLNNN2.Cells(AAAC, 2)
Label2.Caption = "Bestand: " & LLLNNN2.Cells(AAAC, 4) & " " & LLLNNN2.Cells(AAAC, 3)
Label3.Caption = "Gesamtwert: " & Round(LLLNNN2.Cells(AAAC, 5), 2)
Label4.Caption = "Preis " & "/" & LLLNNN2.Cells(AAAC, 3) & " " & Round(LLLNNN2.Cells(AAAC, 6), 2)
End If
End Sub
Sub Z3ZZZLB()
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3) <> LLLNNN2.Cells(SCHOT, 4) Then
LLLNNN2.Cells(SCHOT, 4) = LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3)
End If
If LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4) <> LLLNNN2.Cells(SCHOT, 5) Then
LLLNNN2.Cells(SCHOT, 5) = LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4)
End If
If LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5)) <> LLLNNN2.Cells(SCHOT, 6) Then
LLLNNN2.Cells(SCHOT, 6) = LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5))
End If
Next SCHOT
End Sub
Sub ZZUUFF()
On Error Resume Next
Dim SCHRI As String
Dim TSCH As Long
Dim ††† As Long
SCHRI = ""
SCHRI = LLLNNN2.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге 3!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN3.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге 4!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN4.Name
If SCHRI <> "Накладная выхода артиклей" Then
MsgBox "Ошибка в шаге 5!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN5.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге 6!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN6.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге 7!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN7.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге 39!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Image1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 8!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 9!", , "www.excel.npage.de"
End If
For ††† = 2 To 4
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 10!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Frame1.Left
If TSCH = 6 Then
MsgBox "Ошибка в шаге 11!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Image2.Left
If TSCH = 6 Then
MsgBox "Ошибка в шаге 12!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label5.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 13!", , "www.excel.npage.de"
End If
For ††† = 6 To 8
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 14!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label9.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 15!", , "www.excel.npage.de"
End If
For ††† = 10 To 11
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 16!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ComboBox1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 17!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 18!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton2.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 19!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Frame2.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 21!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label12.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 22!", , "www.excel.npage.de"
End If
For ††† = 13 To 19
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 23!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ComboBox2.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 24!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox3.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 25!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = TextBox1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 26!", , "www.excel.npage.de"
End If
For ††† = 2 To 3
TSCH = 0
TSCH = Me.Controls("TextBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 27!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label20.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 28!", , "www.excel.npage.de"
End If
For ††† = 21 To 22
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 29!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = CommandButton3.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 30!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton4.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 31!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Frame3.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 33!", , "www.excel.npage.de"
End If
For ††† = 23 To 34
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 33!", , "www.excel.npage.de"
End If
Next †††
For ††† = 4 To 5
TSCH = 0
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 33!", , "www.excel.npage.de"
End If
Next †††
For ††† = 5 To 6
TSCH = 0
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 33!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = TextBox5.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 33!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton7.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 35!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton8.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 36!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ListBox1.Left
If TSCH = 6 Then
MsgBox "Ошибка в шаге 37!", , "www.excel.npage.de"
End If
End Sub
Sub ZZZUUFAF()
On Error GoTo ERR
TBB1.BackColor = &HC0FFFF
TBB2.BackColor = &HC0FFFF
KuNr.Enabled = True
KuNr.BackColor = &HC0FFFF
Dim IC As String
IC = CoB1
If CoB1 > "" Then
Sheets(IC).Activate
End If
If ActiveSheet.Name <> "Zailer" And ActiveSheet.Name <> "POMO" Then
Dim AAAZ As Variant
Dim AAAC As Variant
POMO.[a2] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
POMO.[a3] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Column
AAAZ = CDbl(POMO.[a2])
AAAC = CDbl(POMO.[a3])
SPALTA1 = ""
SPALTA2 = ""
SPALTA3 = ""
SPALTA4 = ""
SPALTA5 = ""
SPALTA6 = ""
SPALTA7 = ""
SPALTB1 = ""
SPALTB2 = ""
SPALTB3 = ""
SPALTB4 = ""
SPALTB5 = ""
SPALTB6 = ""
SPALTB7 = ""
SPALTC1 = ""
SPALTC2 = ""
SPALTC3 = ""
SPALTC4 = ""
SPALTC5 = ""
SPALTC6 = ""
SPALTC7 = ""
SPALTD1 = ""
SPALTD2 = ""
SPALTD3 = ""
SPALTD4 = ""
SPALTD5 = ""
SPALTD6 = ""
SPALTD7 = ""
SPALTE1 = ""
SPALTE2 = ""
SPALTE3 = ""
SPALTE4 = ""
SPALTE5 = ""
SPALTE6 = ""
SPALTE7 = ""
SPALTF1 = ""
SPALTF2 = ""
SPALTF3 = ""
SPALTF4 = ""
SPALTF5 = ""
SPALTF6 = ""
SPALTF7 = ""
SPALTG1 = ""
SPALTG2 = ""
SPALTG3 = ""
SPALTG4 = ""
SPALTG5 = ""
SPALTG6 = ""
SPALTG7 = ""
SPALTA = ""
SPALTB = ""
SPALTC = ""
SPALTD = ""
SPALTE = ""
SPALTF = ""
SPALTG = ""
KuNr = ""
TBB1.Value = ""
TBB2.Value = ""
TBB3.Value = ""
TBB4.Value = ""
TBB5.Value = ""
TBB6.Value = ""
POMO.[a1] = ""
POMO.[b1] = ""
POMO.[c1] = ""
POMO.[d1] = ""
POMO.[e1] = ""
POMO.[F1] = ""
POMO.[g1] = ""
POMO.[h1] = ""
POMO.[i1] = ""
POMO.[j1] = ""
POMO.[k1] = ""
POMO.[L1] = ""
POMO.[m1] = ""
If POMO.[a2] < 65536 Then
Dim ††† As Variant
If POMO.[a3] = 1 Then
POMO.[a4] = 0
††† = POMO.[a4]
End If
If POMO.[a3] = 7 Then
POMO.[a4] = 6
††† = POMO.[a4]
End If
SPALTA = ActiveSheet.Cells(1, AAAC - †††).Value
SPALTB = ActiveSheet.Cells(1, AAAC + 1).Value
SPALTC = ActiveSheet.Cells(1, AAAC + 2).Value
SPALTD = ActiveSheet.Cells(1, AAAC + 3).Value
SPALTE = ActiveSheet.Cells(1, AAAC + 4).Value
SPALTF = ActiveSheet.Cells(1, AAAC + 5).Value
SPALTG = ActiveSheet.Cells(1, AAAC + 6).Value
If POMO.[a2] > 8 Then
SPALTA1 = ActiveSheet.Cells(AAAZ - 6, AAAC - †††).Value
SPALTB1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 1).Value
SPALTC1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 2).Value
SPALTD1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 3).Value
SPALTE1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 4).Value
SPALTF1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 5).Value
SPALTG1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 6).Value
End If
If POMO.[a2] > 7 Then
SPALTA2 = ActiveSheet.Cells(AAAZ - 5, AAAC - †††).Value
SPALTB2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 1).Value
SPALTC2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 2).Value
SPALTD2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 3).Value
SPALTE2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 4).Value
SPALTF2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 5).Value
SPALTG2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 6).Value
End If
If POMO.[a2] > 6 Then
SPALTA3 = ActiveSheet.Cells(AAAZ - 4, AAAC - †††).Value
SPALTB3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 1).Value
SPALTC3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 2).Value
SPALTD3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 3).Value
SPALTE3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 4).Value
SPALTF3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 5).Value
SPALTG3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 6).Value
End If
If POMO.[a2] > 5 Then
SPALTA4 = ActiveSheet.Cells(AAAZ - 3, AAAC - †††).Value
SPALTB4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 1).Value
SPALTC4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 2).Value
SPALTD4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 3).Value
SPALTE4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 4).Value
SPALTF4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 5).Value
SPALTG4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 6).Value
End If
If POMO.[a2] > 4 Then
SPALTA5 = ActiveSheet.Cells(AAAZ - 2, AAAC - †††).Value
SPALTB5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 1).Value
SPALTC5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 2).Value
SPALTD5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 3).Value
SPALTE5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 4).Value
SPALTF5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 5).Value
SPALTG5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 6).Value
End If
If POMO.[a2] > 3 Then
SPALTA6 = ActiveSheet.Cells(AAAZ - 1, AAAC - †††).Value
SPALTB6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 1).Value
SPALTC6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 2).Value
SPALTD6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 3).Value
SPALTE6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 4).Value
SPALTF6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 5).Value
SPALTG6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 6).Value
End If
If POMO.[a2] > 2 Then
SPALTA7 = ActiveSheet.Cells(AAAZ, AAAC - †††).Value
SPALTB7 = ActiveSheet.Cells(AAAZ, AAAC + 1).Value
SPALTC7 = ActiveSheet.Cells(AAAZ, AAAC + 2).Value
SPALTD7 = ActiveSheet.Cells(AAAZ, AAAC + 3).Value
SPALTE7 = ActiveSheet.Cells(AAAZ, AAAC + 4).Value
SPALTF7 = ActiveSheet.Cells(AAAZ, AAAC + 5).Value
SPALTG7 = ActiveSheet.Cells(AAAZ, AAAC + 6).Value
End If
End If
End If
If ActiveSheet.Name <> "Zailer" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
'''4_1_ LB#############