Private Sub CommandButton1_Click()
If (Trim(TextBox1.Text) = "" Or Trim(TextBox2.Text) = "" Or Trim(TextBox3.Text) = "") Then
    MsgBox ("Не заданы некоторые !!! ТЕКСТОВЫЕ ДАННЫЕ !!!")
    Exit Sub
End If
If (OptionButton1.Value = True) Then
    TextBox6.Text = ComboBox1.Text + " за " + ComboBox2.Text + " мiсяць " + Str(DTPicker2.Year) + " року"
    UserForm1.CommonDialog1.Filename = UserForm1.TextBox5.Text
    Workbooks.Open Filename:=UserForm1.CommonDialog1.Filename
    A1 = Trim(UserForm1.CommonDialog1.Filename)
    a2 = Len(A1)
    i = a2
    fr = True
    While (fr)
        If (i <>  0 ) Then
            a3 = Left(A1, i)
            If (Mid(a3, Len(a3)) = ".") Then
                a4 = Len(a3)
            ElseIf (Mid(a3, Len(a3)) = "\") Then
                a5 = Len(a3)
                fr = False
            End If
            i = i -  1 
        Else
            fr = False
        End If
    Wend
    a6 = Mid(A1, a5 +  1 , a4 -  1  - a5)
    Sheets(a6).Select
    fr = True
    i =  2 
    k = "F" + Trim(Str(i))
    While (fr)
        If (Range(k).Text <> "") Then
            A1 = Range(k).Text *  100 
            Range(k).Value = A1
            Range(k).Select
            Selection.NumberFormat = "0"
            i = i +  1 
            k = "F" + Trim(Str(i))
        Else
            fr = False
        End If
    Wend
    Sheets.Add
    Sheets(a6).Select
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Columns("G:G").Select
    Selection.Copy
    Sheets("Лист1").Select
    Columns("A:A").Select
    ActiveSheet.Paste
    Sheets(a6).Select
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Лист1").Select
    Columns("B:B").Select
    ActiveSheet.Paste
    Sheets(a6).Select
    Columns("F:F").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Лист1").Select
    Columns("C:C").Select
    ActiveSheet.Paste
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "ВЕДОМОСТЬ"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = Trim(TextBox1.Text)
    Range("C1").Select
    Sheets(a6).Select
    Range("D2").Select
    Sheets("Лист1").Select
    ActiveCell.FormulaR1C1 = "='" + a6 + "'!R[1]C[1]"
    Selection.NumberFormat = "0"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = Trim(TextBox2.Text)
    Selection.NumberFormat = "0"
   Range("E1").Select
    ActiveCell.FormulaR1C1 = Trim(TextBox3.Text)
    Selection.NumberFormat = "0"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = Trim(DTPicker1.Value)
    Selection.NumberFormat = "General"
fr = True
ddd =  0 
ddd1 =  0 
    i =  2 
    k = "D" + Trim(Str(i))
    k1 = "C" + Trim(Str(i))
    k2 = "A" + Trim(Str(i))
    k3 = "B" + Trim(Str(i))
    While (fr)
        If (Trim(Range(k1).Text) <> "") Then
            If (Trim(Range(k2).Text) <> "" And Trim(Range(k3).Text) <> "") Then
                Range(k).FormulaR1C1 = TextBox6.Text 'Здесь может быть основание платежа
                ddd1 = ddd1 +  1 
                ddd = ddd + Range(k1).Value
                i = i +  1 
                k = "D" + Trim(Str(i))
                k1 = "C" + Trim(Str(i))
                k2 = "A" + Trim(Str(i))
                k3 = "B" + Trim(Str(i))
            Else
                Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Select
                Selection.Delete Shift:=xlUp
            End If
        Else
            fr = False
        End If
    Wend
    Range("G1").Select
    ActiveCell.FormulaR1C1 = ddd
    Selection.NumberFormat = "0"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = ddd1
    Selection.NumberFormat = "0"
    q = MsgBox("Общее количество платежей - " + Trim(Str(ddd1)) + ", общая сумма - " + Trim(Str(ddd /  100 )), vbInformation, "Результат по " + Trim(Str(a6)) + ".dbf")
   
A1:
    CommonDialog1.Filename = ActiveWorkbook.Path + "\" + a6 + ".txt"
    CommonDialog1.Filter = "*.txt"
    CommonDialog1.ShowSave
    If (CommonDialog1.Filename = ".txt") Then
        GoTo A1
    Else
        If (CommonDialog1.Filename <> "*.txt") Then ActiveWorkbook.SaveAs Filename:=CommonDialog1.Filename, _
        FileFormat:=xlTextMSDOS, CreateBackup:=False
    End If
    Windows(a6 + ".txt").Activate
    ActiveWindow.Close (False)
    a8 = a6 + ".txt"
    a9 = ActiveWorkbook.Path + "\zagruzka.bat " + a8 + " " + ActiveWorkbook.Path
    q = Shell(a9, vbMaximizedFocus)
    CommonDialog1.Filename = ""
ElseIf (OptionButton2.Value = True) Then
    Shell (ActiveWorkbook.Path + "\zagruzka.bat" + a8)
    MsgBox ActiveWorkbook.Path
    'здесь идет информация если ВЫГРУЗКА идет в ЭКСЕЛ
End If
End Sub

Private Sub CommandButton2_Click()
CommonDialog1.Filename = ActiveWorkbook.Path + "\" + "*.dbf"
CommonDialog1.Filter = "*.dbf"
CommonDialog1.ShowOpen
If (CommonDialog1.Filename = "*.dbf") Then
    TextBox5.Text = ""
    CommandButton1.Enabled = False
Else
    TextBox5.Text = CommonDialog1.Filename
    CommandButton1.Enabled = True
End If
End Sub

Private Sub CommandButton3_Click()
TextBox6.Text = ComboBox1.Text + " за " + ComboBox2.Text + " мiсяць " + Str(DTPicker2.Year) + " року"
End Sub

Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox3_Change()

End Sub

Private Sub UserForm_Activate()
DTPicker1.Value = Date
ComboBox1.AddItem "Пенсiя "
ComboBox1.AddItem "Допомога "
ComboBox1.ListIndex =  0 
ComboBox2.AddItem "Сiчень"
ComboBox2.AddItem "Лютий"
ComboBox2.AddItem "Березень"
ComboBox2.AddItem "Квiтень"
ComboBox2.AddItem "Травень"
ComboBox2.AddItem "Червень"
ComboBox2.AddItem "Липень"
ComboBox2.AddItem "Серпень"
ComboBox2.AddItem "Вересень"
ComboBox2.AddItem "Жовтень"
ComboBox2.AddItem "Листопад"
ComboBox2.AddItem "Грудень"
ComboBox2.ListIndex =  0 
End Sub