YouTube Playlist

 

Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать

 

 

Перечень производственных этапов и коды

 

 

0_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Вот как это работает

1_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Excel файл

2_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Cоздать маску ввода

3_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Создать лист База данных клиентов

4_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Создать лист Ассортимент товара

5_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Создать лист Формуляр

6_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Создать лист Cписок

7_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Создать Cчёт

8_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label1

9_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_ComboBox1

10_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label2

11_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label3 - 11

12_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Frame1

13_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_ Frame2 Frame3

14_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_ ListBox1

15_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label12

16_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label13 - Label20

17_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label21

18_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_ Label22

19_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_ComboBox2

20_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label23

21_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label24 – Label27

22_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_TextBox1

23_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_CommandButton1

24_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_CommandButton2

25_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label28 - Label36

26_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_ComboBox3 - ComboBox5

27_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label37 - Label41

28_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_TextBox2

29_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_CommandButton3 - CommandButton4

30_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Label42 - Label48

31_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_ComboBox6 - ComboBox7

32_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_TextBox3-TextBox7

33_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_CommandButton5- CommandButton6

34_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Порядок активации в Frame1

35_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Порядок активации в Frame2

36_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Порядок активации в Frame2

37_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_CommandButton7- CommandButton9

38_Программу составления счетов с базой данных клиентов и ассортиментом товара в Excel VBA самим создать_Ввод кода в Userform1

 

 

 

 

 

 

 

 

'''1_1_ R##########

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_ R##########

 

 

 

 

'''2_1_ R##########

=D2*(E2+100)/100

'''2_1_ R##########

 

 

 

 

'''3_1_ R##########

 

Sub AAAUUFAF()

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 <> "Zler" 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 <> "Zler" And ActiveSheet.Name <> "POMO" Then

TANA = ActiveSheet.Name

End If

Exit Sub

ERR:

End Sub

 

 

Private Sub ComboBox1_Change()

On Error GoTo EERR

Dim AAAC As Long

Dim AAAA As Single

Dim strSuchen As Variant

For AAAA = 1 To 10

Me.Controls("Label" & CStr(AAAA + 1)) = ""

If ComboBox1.Value <> "" Then

strSuchen = ComboBox1.Value

AAAC = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)

Me.Controls("Label" & CStr(AAAA + 1)) = RRRRRR2.Cells(1, AAAA + 1) & ": " & RRRRRR2.Cells(AAAC, AAAA + 1)

End If

Next AAAA

Exit Sub

EERR:

ComboBox1.Value = ""

End Sub

 

Private Sub ComboBox2_Change()

On Error GoTo EERR

Label23.Caption = ""

Label24.Caption = ""

Label26.Caption = ""

TextBox1.Value = ""

If ComboBox2.Value <> "" Then

ComboBox4.Value = ""

ComboBox6.Value = ""

Dim AAAC As Long

Dim strSuchen As Variant

strSuchen = ComboBox2.Value

AAAC = CDbl(RRRRRR3.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)

Label23.Caption = RRRRRR3.Cells(AAAC, 2)

On Error Resume Next

Label24.Caption = 0

Label24.Caption = Round(RRRRRR3.Cells(AAAC, 4) * 1, 2)

Label26.Caption = 0

Label26.Caption = RRRRRR3.Cells(AAAC, 5) * 1

End If

Exit Sub

EERR:

ComboBox2.Value = ""

Label23.Caption = ""

Label24.Caption = ""

Label26.Caption = ""

TextBox1.Value = ""

End Sub

 

Private Sub ComboBox3_Change()

On Error GoTo EERR

Label37.Caption = ""

Label38.Caption = ""

Label40.Caption = ""

TextBox2.Value = ""

If ComboBox3.Value <> "" Then

Dim AAAC As Long

Dim strSuchen As Variant

strSuchen = ComboBox3.Value

AAAC = CDbl(RRRRRR3.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)

Label37.Caption = RRRRRR3.Cells(AAAC, 2)

On Error Resume Next

Label38.Caption = 0

Label38.Caption = Round(RRRRRR3.Cells(AAAC, 4) * 1, 2)

Label40.Caption = 0

Label40.Caption = RRRRRR3.Cells(AAAC, 5) * 1

End If

Exit Sub

EERR:

ComboBox3.Value = ""

Label37.Caption = ""

Label38.Caption = ""

Label40.Caption = ""

TextBox2.Value = ""

End Sub

 

Private Sub ComboBox4_Change()

On Error GoTo EERR

ComboBox1.Value = ""

Label21.Caption = ""

Label22.Caption = ""

Dim AAAC As Long

Dim AAAZ As Long

ComboBox5.Value = ""

Dim SCHOT As Long

If ComboBox4.Value <> "" Then

ComboBox2.Value = ""

ComboBox6.Value = ""

ComboBox5.Clear

AAAZ = CDbl(ComboBox4.Value) + 2

If AAAZ = 2 Then

ComboBox4.Value = ""

End If

For SCHOT = 0 To 39

AAAC = 3 + SCHOT * 9

If RRRRRR6.Cells(AAAZ, AAAC).Value <> "" Then

With ComboBox5

.AddItem RRRRRR6.Cells(AAAZ, AAAC).Value

End With

End If

Next SCHOT

ComboBox1.Value = RRRRRR6.Cells(AAAZ, 2).Value

RRRRRR4.Range("a24:g90").Value = ""

Call Z5ZZZBR

Call Z1ZZZL

End If

If ComboBox4.Value = "" Then

ComboBox5.Clear

Call Z5ZZZBR

RRRRRR4.[a24] = "_"

Call Z1ZZZL

End If

Exit Sub

EERR:

MsgBox " Номер счета не существует! ", 48, "www.excel.npage.de    "

ComboBox4.Value = ""

End Sub

 

Private Sub ComboBox4_DropButtonClick()

On Error GoTo EERR

With RRRRRR6

ComboBox4.RowSource = .Range(.Cells(3, 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

With RRRRRR3

ComboBox3.RowSource = .Range(.Cells(2, 100), .Cells(.Cells(Rows.Count, 100).End(xlUp).Row, 100)).Address(External:=True)

End With

ComboBox3.Value = ""

Label37.Caption = ""

Label38.Caption = ""

TextBox2.Value = ""

Label39.Caption = ""

Label40.Caption = ""

Label41.Caption = ""

If ComboBox5.Value <> "" Then

With RRRRRR3

ComboBox3.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)

End With

If CDbl(ComboBox5.Value) > 40 Then

ComboBox5.Value = ""

End If

Dim AAAC As Long

Dim AAAZ As Long

AAAZ = CDbl(ComboBox4.Value) + 2

AAAC = 3 + (CDbl(ComboBox5.Value) - 1) * 9

ComboBox3.Value = RRRRRR6.Cells(AAAZ, AAAC + 1).Value

Label37.Caption = RRRRRR6.Cells(AAAZ, AAAC + 2).Value

Label38.Caption = RRRRRR6.Cells(AAAZ, AAAC + 3).Value

TextBox2.Value = RRRRRR6.Cells(AAAZ, AAAC + 4).Value

Label39.Caption = RRRRRR6.Cells(AAAZ, AAAC + 5).Value

Label40.Caption = RRRRRR6.Cells(AAAZ, AAAC + 6).Value

Label41.Caption = RRRRRR6.Cells(AAAZ, AAAC + 8).Value

End If

Exit Sub

EERR:

ComboBox5.Value = ""

End Sub

 

Private Sub ComboBox6_Change()

On Error GoTo EERR

ComboBox1.Value = ""

Label21.Caption = ""

Label22.Caption = ""

ComboBox1.Value = ""

TextBox3.Value = ""

TextBox4.Value = ""

ComboBox7.Value = ""

TextBox5.Value = ""

TextBox6.Value = ""

TextBox7.Value = ""

Dim AAAZ As Long

If ComboBox6.Value <> "" Then

ComboBox2.Value = ""

ComboBox4.Value = ""

AAAZ = CDbl(ComboBox6.Value) + 2

If AAAZ = 2 Then

ComboBox6.Value = ""

End If

ComboBox1.Value = RRRRRR6.Cells(AAAZ, 2).Value

TextBox3.Value = RRRRRR6.Cells(AAAZ, 366).Value

TextBox4.Value = RRRRRR6.Cells(AAAZ, 367).Value

ComboBox7.Value = RRRRRR6.Cells(AAAZ, 368).Value

TextBox5.Value = RRRRRR6.Cells(AAAZ, 369).Value

TextBox6.Value = RRRRRR6.Cells(AAAZ, 370).Value

TextBox7.Value = RRRRRR6.Cells(AAAZ, 371).Value

RRRRRR4.Range("a24:g90").Value = ""

Call Z6ZZZMR

Call Z1ZZZL

End If

If ComboBox6.Value = "" Then

Call Z6ZZZMR

RRRRRR4.[a24] = "_"

Call Z1ZZZL

End If

Exit Sub

EERR:

MsgBox "Номер счета не существует!", 48, "www.excel.npage.de    "

ComboBox6.Value = ""

End Sub

 

Private Sub ComboBox6_DropButtonClick()

On Error GoTo EERR

With RRRRRR6

ComboBox6.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)

End With

Exit Sub

EERR:

End Sub

 

Private Sub ComboBox7_Change()

On Error GoTo EERR

If ComboBox7.Value <> "" Then

If ComboBox7.Value = "Не оплачен" Or ComboBox7.Value = "Оплачен" Or ComboBox7.Value = "Сторнирован" Then

Exit Sub

Else:

ComboBox7.Value = ""

End If

End If

Exit Sub

EERR:

End Sub

 

Private Sub CommandButton1_Click()

On Error GoTo EERR

If RRRRRR6.[a10001] <> "" Then

MsgBox " Нет места для новых счетов!", 48, "www.excel.npage.de    "

ComboBox2.SetFocus

Exit Sub

End If

If ComboBox2.Value = "" Then

MsgBox "Артикль не выбран!", 48, "www.excel.npage.de    "

ComboBox2.SetFocus

Exit Sub

End If

If TextBox1.Value = "" Then

MsgBox " Количество артикля не указано!", 48, "www.excel.npage.de    "

TextBox1.SetFocus

Exit Sub

End If

Dim AAAZ As Long

Dim AAAC As Long

Dim SCHOT As Long

Dim AAAC2 As Long

AAAZ = CDbl(Label21.Caption) + 2

AAAC = 3 + (CDbl(Label22.Caption) - 1) * 9

If RRRRRR6.Cells(AAAZ, AAAC) <> "" Then

MsgBox "Уже Создано 40 позиций!", 48, "www.excel.npage.de    "

ComboBox2.SetFocus

Exit Sub

End If

RRRRRR6.Cells(AAAZ, 1).Value = AAAZ - 2

RRRRRR6.Cells(AAAZ, 2) = ComboBox1.Value

RRRRRR6.Cells(AAAZ, AAAC) = CDbl(Label22.Caption)

RRRRRR6.Cells(AAAZ, AAAC + 1) = ComboBox2.Value

RRRRRR6.Cells(AAAZ, AAAC + 2) = Label23.Caption

RRRRRR6.Cells(AAAZ, AAAC + 3) = CDbl(Label24.Caption)

RRRRRR6.Cells(AAAZ, AAAC + 4) = CDbl(TextBox1.Value)

RRRRRR6.Cells(AAAZ, AAAC + 5) = CDbl(Label25.Caption)

RRRRRR6.Cells(AAAZ, AAAC + 6) = CDbl(Label26.Caption)

RRRRRR6.Cells(AAAZ, AAAC + 7) = Round(CDbl(Label25.Caption) * CDbl(Label26.Caption) / 100, 2)

RRRRRR6.Cells(AAAZ, AAAC + 8) = CDbl(Label27.Caption)

RRRRRR6.Cells(AAAZ, 363) = ""

RRRRRR6.Cells(AAAZ, 364) = ""

RRRRRR6.Cells(AAAZ, 365) = ""

For SCHOT = 0 To 39

AAAC2 = 3 + SCHOT * 9

RRRRRR6.Cells(AAAZ, 363) = RRRRRR6.Cells(AAAZ, 363) + RRRRRR6.Cells(AAAZ, AAAC2 + 5)

RRRRRR6.Cells(AAAZ, 364) = RRRRRR6.Cells(AAAZ, 364) + RRRRRR6.Cells(AAAZ, AAAC2 + 7)

RRRRRR6.Cells(AAAZ, 365) = RRRRRR6.Cells(AAAZ, 365) + RRRRRR6.Cells(AAAZ, AAAC2 + 8)

RRRRRR6.Cells(AAAZ, 368) = "Не оплачен"

Next SCHOT

RRRRRR6.Cells(AAAZ, 366) = Date

Call Z3ZZZPR

ComboBox2.Value = ""

TextBox1.Value = ""

ComboBox2.SetFocus

RRRRRR4.Range("a24:g90").Value = ""

Call Z4ZZZNR

Call Z1ZZZL

Exit Sub

EERR:

End Sub

 

Private Sub CommandButton2_Click()

On Error GoTo EERR

Call Z4ZZZNR

Dim ††† As Long

RRRRRR6.Activate

RRRRRR6.[nh2].Select

Selection.Copy

RRRRRR4.Activate

††† = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row)

RRRRRR4.Cells(††† + 2, 1).Select

ActiveSheet.Paste

RRRRRR4.Cells(††† + 2, 1).RowHeight = RRRRRR6.[nh2].RowHeight

Application.CutCopyMode = False

RRRRRR4.Activate

ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 2).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 4).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 6).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 7).EntireColumn.AutoFit

With ActiveSheet.PageSetup

.RightHeader = "Rechnung-Nr.: " & RRRRRR4.[g7] & "   &P/&N"

End With

UserForm1.Hide

Exit Sub

EERR:

End Sub

 

Private Sub CommandButton3_Click()

On Error GoTo EERR

If ComboBox5.Value = "" Then

MsgBox " Номер позиции не выбран!", 48, "www.excel.npage.de    "

ComboBox5.SetFocus

Exit Sub

End If

TextBox2.SetFocus

ComboBox5.SetFocus

Dim AAAZ As Long

Dim AAAC As Long

Dim SCHOT As Long

Dim AAAC2 As Long

AAAZ = CDbl(ComboBox4.Value) + 2

If RRRRRR6.Cells(AAAZ, 368) <> "" Then

If RRRRRR6.Cells(AAAZ, 368) = "Оплачен" Or RRRRRR6.Cells(AAAZ, 368) = "Сторнирован" Then

MsgBox " Счет уже как " & RRRRRR6.Cells(AAAZ, 368) & " маркирован!", 48, "www.excel.npage.de    "

ComboBox5.SetFocus

Exit Sub

End If

End If

AAAC = 3 + (CDbl(ComboBox5.Value) - 1) * 9

RRRRRR6.Cells(AAAZ, 2) = ComboBox1.Value

RRRRRR6.Cells(AAAZ, AAAC) = CDbl(ComboBox5.Value)

RRRRRR6.Cells(AAAZ, AAAC + 1) = ComboBox3.Value

RRRRRR6.Cells(AAAZ, AAAC + 2) = Label37.Caption

If Label38.Caption <> "" Then

RRRRRR6.Cells(AAAZ, AAAC + 3) = CDbl(Label38.Caption)

Else:

RRRRRR6.Cells(AAAZ, AAAC + 3) = ""

End If

If TextBox2.Value <> "" Then

RRRRRR6.Cells(AAAZ, AAAC + 4) = CDbl(TextBox2.Value)

Else:

RRRRRR6.Cells(AAAZ, AAAC + 4) = ""

End If

If Label39.Caption <> "" Then

RRRRRR6.Cells(AAAZ, AAAC + 5) = CDbl(Label39.Caption)

Else:

RRRRRR6.Cells(AAAZ, AAAC + 5) = ""

End If

If Label40.Caption <> "" Then

RRRRRR6.Cells(AAAZ, AAAC + 6) = CDbl(Label40.Caption)

Else:

RRRRRR6.Cells(AAAZ, AAAC + 6) = ""

End If

If Label39.Caption <> "" And Label40.Caption <> "" Then

RRRRRR6.Cells(AAAZ, AAAC + 7) = Round(CDbl(Label39.Caption) * CDbl(Label40.Caption) / 100, 2)

Else:

RRRRRR6.Cells(AAAZ, AAAC + 7) = ""

End If

If Label41.Caption <> "" Then

RRRRRR6.Cells(AAAZ, AAAC + 8) = CDbl(Label41.Caption)

Else:

RRRRRR6.Cells(AAAZ, AAAC + 8) = ""

End If

RRRRRR6.Cells(AAAZ, 363) = ""

RRRRRR6.Cells(AAAZ, 364) = ""

RRRRRR6.Cells(AAAZ, 365) = ""

For SCHOT = 0 To 39

AAAC2 = 3 + SCHOT * 9

RRRRRR6.Cells(AAAZ, 363) = RRRRRR6.Cells(AAAZ, 363) + RRRRRR6.Cells(AAAZ, AAAC2 + 5)

RRRRRR6.Cells(AAAZ, 364) = RRRRRR6.Cells(AAAZ, 364) + RRRRRR6.Cells(AAAZ, AAAC2 + 7)

RRRRRR6.Cells(AAAZ, 365) = RRRRRR6.Cells(AAAZ, 365) + RRRRRR6.Cells(AAAZ, AAAC2 + 8)

Next SCHOT

RRRRRR6.Cells(AAAZ, 367) = Date

ComboBox5.Clear

For SCHOT = 0 To 39

AAAC = 3 + SCHOT * 9

If RRRRRR6.Cells(AAAZ, AAAC).Value <> "" Then

With ComboBox5

.AddItem RRRRRR6.Cells(AAAZ, AAAC).Value

End With

End If

Next SCHOT

ComboBox3.Value = ""

TextBox2.Value = ""

ComboBox5.SetFocus

RRRRRR4.Range("a24:g90").Value = ""

Call Z5ZZZBR

Call Z1ZZZL

Exit Sub

EERR:

 

End Sub

 

Private Sub CommandButton4_Click()

On Error GoTo EERR

Call Z5ZZZBR

Dim ††† As Long

RRRRRR6.Activate

RRRRRR6.[nh2].Select

Selection.Copy

RRRRRR4.Activate

††† = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row)

RRRRRR4.Cells(††† + 2, 1).Select

ActiveSheet.Paste

RRRRRR4.Cells(††† + 2, 1).RowHeight = RRRRRR6.[nh2].RowHeight

Application.CutCopyMode = False

RRRRRR4.Activate

ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 2).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 4).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 6).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 7).EntireColumn.AutoFit

With ActiveSheet.PageSetup

.RightHeader = "Rechnung-Nr.: " & RRRRRR4.[g7] & "   &P/&N"

End With

UserForm1.Hide

Exit Sub

EERR:

End Sub

 

Private Sub CommandButton5_Click()

On Error GoTo EERR

TextBox3.SetFocus

TextBox4.SetFocus

TextBox6.SetFocus

ComboBox6.SetFocus

Dim AAAZ As Long

If ComboBox6.Value <> "" Then

AAAZ = CDbl(ComboBox6.Value) + 2

RRRRRR6.Cells(AAAZ, 2) = ComboBox1.Value

If TextBox3.Value <> "" Then

RRRRRR6.Cells(AAAZ, 366) = CDate(TextBox3.Value)

Else:

RRRRRR6.Cells(AAAZ, 366) = ""

End If

If TextBox4.Value <> "" Then

RRRRRR6.Cells(AAAZ, 367) = CDate(TextBox4.Value)

Else:

RRRRRR6.Cells(AAAZ, 367) = ""

End If

RRRRRR6.Cells(AAAZ, 368) = ComboBox7.Value

RRRRRR6.Cells(AAAZ, 369) = TextBox5.Value

If TextBox6.Value <> "" Then

RRRRRR6.Cells(AAAZ, 370) = CDate(TextBox6.Value)

Else:

RRRRRR6.Cells(AAAZ, 370) = ""

End If

RRRRRR6.Cells(AAAZ, 371) = TextBox7.Value

RRRRRR4.Range("a24:g90").Value = ""

Call Z6ZZZMR

Call Z1ZZZL

End If

If ComboBox6.Value = "" Then

Call Z6ZZZMR

RRRRRR4.[a24] = "_"

Call Z1ZZZL

End If

Exit Sub

EERR:

End Sub

 

Private Sub CommandButton6_Click()

On Error GoTo EERR

Call Z6ZZZMR

Dim ††† As Long

RRRRRR6.Activate

RRRRRR6.[nh2].Select

Selection.Copy

RRRRRR4.Activate

††† = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row)

RRRRRR4.Cells(††† + 2, 1).Select

ActiveSheet.Paste

RRRRRR4.Cells(††† + 2, 1).RowHeight = RRRRRR6.[nh2].RowHeight

Application.CutCopyMode = False

RRRRRR4.Activate

ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 2).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 4).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 6).EntireColumn.AutoFit

ActiveSheet.Cells(Rows.Count, 7).EntireColumn.AutoFit

With ActiveSheet.PageSetup

.RightHeader = "Rechnung-Nr.: " & RRRRRR4.[g7] & "   &P/&N"

End With

UserForm1.Hide

Exit Sub

EERR:

End Sub

 

Private Sub CommandButton7_Click()

On Error GoTo EERR

Label21.Caption = ""

ComboBox2.Value = ""

ComboBox4.Value = ""

ComboBox6.Value = ""

ComboBox1.Value = ""

Call Z2ZZZNR

Call Z3ZZZPR

Exit Sub

EERR:

End Sub

 

Private Sub CommandButton9_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

RRRRRR6.Range("a2:ng65530").Value = ""

MsgBox " Все удалено!", 48, "www.excel.npage.de    "

Exit Sub

EERR:

End Sub

 

Private Sub CommandButton8_Click()

On Error GoTo EERR

RRRRRR6.Activate

Cells.Select

Selection.Copy

RRRRRR5.Activate

RRRRRR5.[a1].Select

ActiveSheet.Paste

Dim SCHOT As Long

For SCHOT = 1 To 374

ActiveSheet.Cells(Rows.Count, SCHOT).EntireColumn.AutoFit

Next SCHOT

RRRRRR5.[a1].Select

Application.CutCopyMode = False

ActiveSheet.AutoFilterMode = False

UserForm1.Hide

Exit Sub

EERR:

UserForm1.Hide

End Sub

 

Sub DDDUUFAF()

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 <> "Zler" 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 <> "Zler" And ActiveSheet.Name <> "POMO" Then

TANA = ActiveSheet.Name

End If

Exit Sub

ERR:

End Sub

 

 

Private Sub TextBox1_Change()

On Error GoTo EERR

Label25.Caption = ""

Label27.Caption = ""

If TextBox1.Value <> "" Then

Label25.Caption = Round(CDbl(TextBox1.Value) * CDbl(Label24.Caption), 2)

Label27.Caption = Round(CDbl(Label25.Caption) * (CDbl(Label26.Caption) + 100) / 100, 2)

End If

Exit Sub

EERR:

TextBox1.Value = ""

End Sub

 

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

On Error GoTo EERR

Label39.Caption = ""

Label41.Caption = ""

TextBox2.Value = CDbl(TextBox2.Value) * 1

If ComboBox3.Value <> "" Then

Dim AAAC As Long

Dim strSuchen As Variant

strSuchen = ComboBox3.Value

AAAC = CDbl(RRRRRR3.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)

Label37.Caption = RRRRRR3.Cells(AAAC, 2)

On Error Resume Next

Label38.Caption = 0

Label38.Caption = Round(RRRRRR3.Cells(AAAC, 4) * 1, 2)

Label40.Caption = 0

Label40.Caption = RRRRRR3.Cells(AAAC, 5) * 1

End If

If TextBox2.Value <> "" Then

Label39.Caption = Round(CDbl(TextBox2.Value) * CDbl(Label38.Caption), 2)

Label41.Caption = Round(CDbl(Label39.Caption) * (CDbl(Label40.Caption) + 100) / 100, 2)

End If

Exit Sub

EERR:

TextBox2.Value = ""

End Sub

 

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)

On Error GoTo EERR

If TextBox3.Value <> "" Then

TextBox3.Value = CDate(TextBox3)

End If

Exit Sub

EERR:

TextBox3.Value = Date

End Sub

 

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)

On Error GoTo EERR

If TextBox4.Value <> "" Then

TextBox4.Value = CDate(TextBox4)

End If

Exit Sub

EERR:

TextBox4.Value = Date

End Sub

 

Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)

On Error GoTo EERR

If TextBox6.Value <> "" Then

TextBox6.Value = CDate(TextBox6)

End If

Exit Sub

EERR:

TextBox6.Value = Date

End Sub

 

Private Sub UserForm_Activate()

On Error GoTo EERR

RRRRRR4.Activate

ActiveWindow.View = xlNormalView

RRRRRR1.Activate

Exit Sub

EERR:

End Sub

 

Private Sub UserForm_Initialize()

On Error GoTo EERR

Call ZZUUFF

With UserForm1

.Height = 431

.Width = 605

End With

With Me

End With

With RRRRRR2

ComboBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)

End With

Call rrrrch

Call Z1ZZZL

Call Z2ZZZNR

Call Z3ZZZPR

With RRRRRR3

ComboBox2.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)

End With

ComboBox7.Clear

With ComboBox7

.AddItem "Не оплачен"

.AddItem "Оплачен"

.AddItem "Сторнирован"

End With

Exit Sub

EERR:

End Sub

 

Sub rrrrch()

On Error GoTo EERR

If RRRRRR1.Cells(1961, 1962) <> Date Then

RRRRRR1.Cells(1961, 1962) = Date

ActiveWorkbook.FollowHyperlink Address:="https://youtu.be/X6urDzACwek", NewWindow:=True

End If

Exit Sub

EERR:

End Sub

 

 

Sub Z1ZZZL()

On Error GoTo EERR

With RRRRRR4

ListBox1.RowSource = .Range(.Cells(24, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 7)).Address(External:=True)

ListBox1.ListIndex = ListBox1.ListCount - 1

End With

Exit Sub

EERR:

End Sub

 

Sub Z2ZZZNR()

On Error GoTo EERR

RRRRRR6.[a2] = 0

RRRRRR6.[c2] = 0

Dim AAAZ As Long

AAAZ = CDbl(RRRRRR6.Cells(Rows.Count, 1).End(xlUp).Row)

Label21.Caption = AAAZ - 1

RRRRRR4.Range("a24:g90").Value = ""

RRRRRR4.[a24] = "_"

Exit Sub

EERR:

End Sub

 

Sub Z3ZZZPR()

On Error GoTo EERR

Dim SCHOT As Long

Dim AAAC As Long

Dim AAAZ As Long

AAAZ = CDbl(Label21.Caption) + 2

For SCHOT = 0 To 39

AAAC = 3 + SCHOT * 9

If RRRRRR6.Cells(AAAZ, AAAC).Value = "" Then

Label22.Caption = SCHOT + 1

Exit Sub

End If

Next SCHOT

Exit Sub

EERR:

End Sub

 

Sub Z4ZZZNR()

On Error GoTo EERR

Dim AAAZ As Long

Dim AAAZ2 As Long

Dim AAAC As Long

Dim AAAZ3 As Long

Dim SCHOT As Long

Dim strSuchen As Variant

RRRRRR4.[g6] = ""

RRRRRR4.[g7] = ""

RRRRRR4.[g8] = ""

RRRRRR4.[g9] = ""

RRRRRR4.[a6] = ""

RRRRRR4.[a7] = ""

RRRRRR4.[a8] = ""

RRRRRR4.[a9] = ""

RRRRRR4.[a10] = ""

RRRRRR4.[a11] = ""

RRRRRR4.[a12] = ""

RRRRRR4.Range("a24:g90").Value = ""

RRRRRR4.Range("a24:g90").Font.Size = 11

RRRRRR4.Activate

RRRRRR4.Range("a24:g90").UnMerge

RRRRRR4.Range("a24:g90").RowHeight = 15

RRRRRR4.Range("a24:g90").HorizontalAlignment = xlCenter

AAAZ = CDbl(Label21.Caption) + 2

RRRRRR4.[g6] = RRRRRR6.Cells(AAAZ, 2)

RRRRRR4.[g7] = CDbl(Label21.Caption)

RRRRRR4.[g8] = RRRRRR6.Cells(AAAZ, 366)

If RRRRRR4.[g8] <> "" Then

RRRRRR4.[g8] = CDate(RRRRRR6.Cells(AAAZ, 366))

Else:

RRRRRR4.[g8] = ""

End If

RRRRRR4.[e9] = ""

RRRRRR4.[g9] = ""

strSuchen = RRRRRR6.Cells(AAAZ, 2)

AAAZ3 = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)

RRRRRR4.[a6] = RRRRRR2.Cells(AAAZ3, 2)

RRRRRR4.[a7] = RRRRRR2.Cells(AAAZ3, 3)

RRRRRR4.[a8] = RRRRRR2.Cells(AAAZ3, 4)

RRRRRR4.[a9] = RRRRRR2.Cells(AAAZ3, 5)

RRRRRR4.[a10] = RRRRRR2.Cells(AAAZ3, 6)

RRRRRR4.[a11] = RRRRRR2.Cells(AAAZ3, 7)

RRRRRR4.[a12] = RRRRRR2.Cells(AAAZ3, 8)

For SCHOT = 0 To 39

AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1

AAAC = 3 + SCHOT * 9

If RRRRRR6.Cells(AAAZ, AAAC) <> "" Then

RRRRRR4.Cells(AAAZ2, 1) = RRRRRR6.Cells(AAAZ, AAAC)

RRRRRR4.Cells(AAAZ2, 2) = RRRRRR6.Cells(AAAZ, AAAC + 1)

RRRRRR4.Cells(AAAZ2, 3) = RRRRRR6.Cells(AAAZ, AAAC + 2)

RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, AAAC + 3) & "_x_" & RRRRRR6.Cells(AAAZ, AAAC + 4)

RRRRRR4.Cells(AAAZ2, 5) = RRRRRR6.Cells(AAAZ, AAAC + 5)

RRRRRR4.Cells(AAAZ2, 6) = RRRRRR6.Cells(AAAZ, AAAC + 6)

RRRRRR4.Cells(AAAZ2, 7) = RRRRRR6.Cells(AAAZ, AAAC + 8)

End If

Next SCHOT

AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1

RRRRRR4.Cells(AAAZ2, 3) = "Нетто:"

RRRRRR4.Cells(AAAZ2 + 1, 3) = "НДС:"

RRRRRR4.Cells(AAAZ2 + 2, 3) = " Брутто:"

RRRRRR4.Cells(AAAZ2 + 2, 1) = "_"

RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, 363)

RRRRRR4.Cells(AAAZ2 + 1, 4) = RRRRRR6.Cells(AAAZ, 364)

RRRRRR4.Cells(AAAZ2 + 2, 4) = RRRRRR6.Cells(AAAZ, 365)

Exit Sub

EERR:

End Sub

 

Sub Z5ZZZBR()

On Error GoTo EERR

Dim AAAZ As Long

Dim AAAZ2 As Long

Dim AAAC As Long

Dim AAAZ3 As Long

Dim SCHOT As Long

Dim strSuchen As Variant

RRRRRR4.Activate

RRRRRR4.Range("a24:g90").UnMerge

RRRRRR4.Range("a24:g90").RowHeight = 15

RRRRRR4.Range("a24:g90").Value = ""

RRRRRR4.Range("a24:g90").HorizontalAlignment = xlCenter

RRRRRR4.[g6] = ""

RRRRRR4.[g7] = ""

RRRRRR4.[g8] = ""

RRRRRR4.[g9] = ""

RRRRRR4.[a6] = ""

RRRRRR4.[a7] = ""

RRRRRR4.[a8] = ""

RRRRRR4.[a9] = ""

RRRRRR4.[a10] = ""

RRRRRR4.[a11] = ""

RRRRRR4.[a12] = ""

RRRRRR4.Range("a24:g90").Value = ""

RRRRRR4.Range("a24:g90").Font.Size = 11

AAAZ = CDbl(ComboBox4.Value) + 2

RRRRRR4.[g6] = RRRRRR6.Cells(AAAZ, 2)

RRRRRR4.[g7] = CDbl(ComboBox4.Value)

RRRRRR4.[g8] = RRRRRR6.Cells(AAAZ, 366)

If RRRRRR4.[g8] <> "" Then

RRRRRR4.[g8] = CDate(RRRRRR6.Cells(AAAZ, 366))

Else:

RRRRRR4.[g8] = ""

End If

If RRRRRR6.Cells(AAAZ, 367) <> "" Then

RRRRRR4.[e9] = "Geändert am:"

RRRRRR4.[g9] = CDate(RRRRRR6.Cells(AAAZ, 367))

Else:

RRRRRR4.[e9] = ""

RRRRRR4.[g9] = ""

End If

strSuchen = RRRRRR6.Cells(AAAZ, 2)

AAAZ3 = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)

RRRRRR4.[a6] = RRRRRR2.Cells(AAAZ3, 2)

RRRRRR4.[a7] = RRRRRR2.Cells(AAAZ3, 3)

RRRRRR4.[a8] = RRRRRR2.Cells(AAAZ3, 4)

RRRRRR4.[a9] = RRRRRR2.Cells(AAAZ3, 5)

RRRRRR4.[a10] = RRRRRR2.Cells(AAAZ3, 6)

RRRRRR4.[a11] = RRRRRR2.Cells(AAAZ3, 7)

RRRRRR4.[a12] = RRRRRR2.Cells(AAAZ3, 8)

For SCHOT = 0 To 39

AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1

AAAC = 3 + SCHOT * 9

If RRRRRR6.Cells(AAAZ, AAAC) <> "" Then

RRRRRR4.Cells(AAAZ2, 1) = RRRRRR6.Cells(AAAZ, AAAC)

RRRRRR4.Cells(AAAZ2, 2) = RRRRRR6.Cells(AAAZ, AAAC + 1)

RRRRRR4.Cells(AAAZ2, 3) = RRRRRR6.Cells(AAAZ, AAAC + 2)

RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, AAAC + 3) & "_x_" & RRRRRR6.Cells(AAAZ, AAAC + 4)

RRRRRR4.Cells(AAAZ2, 5) = RRRRRR6.Cells(AAAZ, AAAC + 5)

RRRRRR4.Cells(AAAZ2, 6) = RRRRRR6.Cells(AAAZ, AAAC + 6)

RRRRRR4.Cells(AAAZ2, 7) = RRRRRR6.Cells(AAAZ, AAAC + 8)

End If

Next SCHOT

AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1

RRRRRR4.Cells(AAAZ2, 3) = "Нетто:"

RRRRRR4.Cells(AAAZ2 + 1, 3) = "НДС:"

RRRRRR4.Cells(AAAZ2 + 2, 3) = " Брутто:"

RRRRRR4.Cells(AAAZ2 + 2, 1) = "_"

RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, 363)

RRRRRR4.Cells(AAAZ2 + 1, 4) = RRRRRR6.Cells(AAAZ, 364)

RRRRRR4.Cells(AAAZ2 + 2, 4) = RRRRRR6.Cells(AAAZ, 365)

Exit Sub

EERR:

End Sub

 

Sub Z6ZZZMR()

On Error GoTo EERR

Dim AAAZ As Long

Dim AAAZ2 As Long

Dim AAAC As Long

Dim AAAZ3 As Long

Dim SCHOT As Long

Dim strSuchen As Variant

RRRRRR4.Range("a24:g90").Value = ""

RRRRRR4.Activate

RRRRRR4.Range("a24:g90").UnMerge

RRRRRR4.Range("a24:g90").RowHeight = 15

RRRRRR4.Range("a24:g90").HorizontalAlignment = xlCenter

RRRRRR4.[g6] = ""

RRRRRR4.[g7] = ""

RRRRRR4.[g8] = ""

RRRRRR4.[g9] = ""

RRRRRR4.[a6] = ""

RRRRRR4.[a7] = ""

RRRRRR4.[a8] = ""

RRRRRR4.[a9] = ""

RRRRRR4.[a10] = ""

RRRRRR4.[a11] = ""

RRRRRR4.[a12] = ""

RRRRRR4.Range("a24:g90").Value = ""

RRRRRR4.Range("a24:g90").Font.Size = 11

AAAZ = CDbl(ComboBox6.Value) + 2

RRRRRR4.[g6] = RRRRRR6.Cells(AAAZ, 2)

RRRRRR4.[g7] = CDbl(ComboBox6.Value)

RRRRRR4.[g8] = RRRRRR6.Cells(AAAZ, 366)

If RRRRRR4.[g8] <> "" Then

RRRRRR4.[g8] = CDate(RRRRRR6.Cells(AAAZ, 366))

Else:

RRRRRR4.[g8] = ""

End If

If RRRRRR6.Cells(AAAZ, 367) <> "" Then

RRRRRR4.[e9] = "Geändert am:"

RRRRRR4.[g9] = CDate(RRRRRR6.Cells(AAAZ, 367))

Else:

RRRRRR4.[e9] = ""

RRRRRR4.[g9] = ""

End If

strSuchen = RRRRRR6.Cells(AAAZ, 2)

AAAZ3 = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)

RRRRRR4.[a6] = RRRRRR2.Cells(AAAZ3, 2)

RRRRRR4.[a7] = RRRRRR2.Cells(AAAZ3, 3)

RRRRRR4.[a8] = RRRRRR2.Cells(AAAZ3, 4)

RRRRRR4.[a9] = RRRRRR2.Cells(AAAZ3, 5)

RRRRRR4.[a10] = RRRRRR2.Cells(AAAZ3, 6)

RRRRRR4.[a11] = RRRRRR2.Cells(AAAZ3, 7)

RRRRRR4.[a12] = RRRRRR2.Cells(AAAZ3, 8)

For SCHOT = 0 To 39

AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1

AAAC = 3 + SCHOT * 9

If RRRRRR6.Cells(AAAZ, AAAC) <> "" Then

RRRRRR4.Cells(AAAZ2, 1) = RRRRRR6.Cells(AAAZ, AAAC)

RRRRRR4.Cells(AAAZ2, 2) = RRRRRR6.Cells(AAAZ, AAAC + 1)

RRRRRR4.Cells(AAAZ2, 3) = RRRRRR6.Cells(AAAZ, AAAC + 2)

RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, AAAC + 3) & "_x_" & RRRRRR6.Cells(AAAZ, AAAC + 4)

RRRRRR4.Cells(AAAZ2, 5) = RRRRRR6.Cells(AAAZ, AAAC + 5)

RRRRRR4.Cells(AAAZ2, 6) = RRRRRR6.Cells(AAAZ, AAAC + 6)

RRRRRR4.Cells(AAAZ2, 7) = RRRRRR6.Cells(AAAZ, AAAC + 8)

End If

Next SCHOT

AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1

RRRRRR4.Cells(AAAZ2, 3) = "Нетто:"

RRRRRR4.Cells(AAAZ2 + 1, 3) = "НДС:"

RRRRRR4.Cells(AAAZ2 + 2, 3) = " Брутто:"

RRRRRR4.Cells(AAAZ2 + 2, 1) = "_"

RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, 363)

RRRRRR4.Cells(AAAZ2 + 1, 4) = RRRRRR6.Cells(AAAZ, 364)

RRRRRR4.Cells(AAAZ2 + 2, 4) = RRRRRR6.Cells(AAAZ, 365)

Exit Sub

EERR:

End Sub

 

Sub ZZUUFF()

On Error Resume Next

Dim SCHRI As String

Dim TSCH As Long

Dim ††† As Long

SCHRI = ""

SCHRI = RRRRRR2.Name

If SCHRI = "" Then

MsgBox "Ошибка в шаге 3!", , "www.excel.npage.de"

End If

SCHRI = ""

SCHRI = RRRRRR3.Name

If SCHRI = "" Then

MsgBox "Ошибка в шаге 4!", , "www.excel.npage.de"

End If

SCHRI = ""

SCHRI = RRRRRR4.Name

If SCHRI = "" Then

MsgBox "Ошибка в шаге 5!", , "www.excel.npage.de"

End If

SCHRI = ""

SCHRI = RRRRRR5.Name

If SCHRI = "" Then

MsgBox "Ошибка в шаге 6!", , "www.excel.npage.de"

End If

SCHRI = ""

SCHRI = RRRRRR6.Name

If SCHRI = "" Then

MsgBox "Ошибка в шаге 7!", , "www.excel.npage.de"

End If

TSCH = 0

TSCH = Label1.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 8!", , "www.excel.npage.de"

End If

TSCH = 0

TSCH = ComboBox1.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 9!", , "www.excel.npage.de"

End If

TSCH = 0

TSCH = Label2.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 10!", , "www.excel.npage.de"

End If

For ††† = 3 To 11

TSCH = 0

TSCH = Me.Controls("Label" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 11!", , "www.excel.npage.de"

End If

Next †††

TSCH = 1

TSCH = Frame1.Left

If TSCH <> 0 Then

MsgBox "Ошибка в шаге 12!", , "www.excel.npage.de"

End If

For ††† = 2 To 3

TSCH = 0

TSCH = Me.Controls("Frame" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 13!", , "www.excel.npage.de"

End If

Next †††

TSCH = 1

TSCH = ListBox1.Left

If TSCH <> 0 Then

MsgBox "Ошибка в шаге 14!", , "www.excel.npage.de"

End If

TSCH = 0

TSCH = Label12.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 15!", , "www.excel.npage.de"

End If

For ††† = 13 To 20

TSCH = 0

TSCH = Me.Controls("Label" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 16!", , "www.excel.npage.de"

End If

Next †††

TSCH = 0

TSCH = Label21.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 17!", , "www.excel.npage.de"

End If

TSCH = 0

TSCH = Label22.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 18!", , "www.excel.npage.de"

End If

TSCH = 0

TSCH = ComboBox2.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 19!", , "www.excel.npage.de"

End If

TSCH = 0

TSCH = Label23.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 20!", , "www.excel.npage.de"

End If

For ††† = 24 To 27

TSCH = 0

TSCH = Me.Controls("Label" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 21!", , "www.excel.npage.de"

End If

Next †††

TSCH = 0

TSCH = TextBox1.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 22!", , "www.excel.npage.de"

End If

TSCH = 0

TSCH = CommandButton1.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 23!", , "www.excel.npage.de"

End If

TSCH = 0

TSCH = CommandButton2.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 24!", , "www.excel.npage.de"

End If

For ††† = 28 To 36

TSCH = 0

TSCH = Me.Controls("Label" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 25!", , "www.excel.npage.de"

End If

Next †††

For ††† = 3 To 5

TSCH = 0

TSCH = Me.Controls("ComboBox" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 26!", , "www.excel.npage.de"

End If

Next †††

For ††† = 37 To 41

TSCH = 0

TSCH = Me.Controls("Label" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 27!", , "www.excel.npage.de"

End If

Next †††

TSCH = 0

TSCH = TextBox2.Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 28!", , "www.excel.npage.de"

End If

For ††† = 3 To 4

TSCH = 0

TSCH = Me.Controls("CommandButton" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 29!", , "www.excel.npage.de"

End If

Next †††

For ††† = 42 To 48

TSCH = 0

TSCH = Me.Controls("Label" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 30!", , "www.excel.npage.de"

End If

Next †††

For ††† = 6 To 7

TSCH = 0

TSCH = Me.Controls("ComboBox" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 31!", , "www.excel.npage.de"

End If

Next †††

For ††† = 3 To 7

TSCH = 0

TSCH = Me.Controls("TextBox" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 32!", , "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 †††

For ††† = 7 To 9

TSCH = 0

TSCH = Me.Controls("CommandButton" & CStr(†††)).Left

If TSCH = 0 Then

MsgBox "Ошибка в шаге 37!", , "www.excel.npage.de"

End If

Next †††

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 <> "Zler" 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 <> "Zler" And ActiveSheet.Name <> "POMO" Then

TANA = ActiveSheet.Name

End If

Exit Sub

ERR:

End Sub

 

'''3_1_ R##########