Личная бухгалтерия

End If

'

If LiInd = 1 Then

    Cells(8, 1).Value = "Начальная сумма :"

    Cells(8, ВтораяКолонка).Value = НачальнаяСумма

    Cells(РядКонечнойСуммы, 1).Value = "Конечная сумма :"

    Cells(РядКонечнойСуммы, ВтораяКолонка).Value = КонечнаяСумма

End If

'

Set MultyRange = Union(Range(Cells(8, 1), Cells(8, ВтораяКолонка)), _

    Range(Cells(РядКонечнойСуммы, 1), Cells(РядКонечнойСуммы, ВтораяКолонка)))

MultyRange.Font.Size = 14

MultyRange.Font.ColorIndex = 11

Set MultyRange = Union(Cells(8, ВтораяКолонка), _

            Cells(РядКонечнойСуммы, ВтораяКолонка))

MultyRange.NumberFormat = "#,##0.00"

'

For TableNum = 1 To 2

    '

    Ряд1 = CStr(9 + (TableNum - 1) * СдвигТаблиц)

    Ряд2 = CStr(10 + (TableNum - 1) * СдвигТаблиц)

    Rows(Ряд1).Font.Size = 12

    Rows(Ряд1).Font.ColorIndex = 11

    Rows(Ряд2).Font.Size = 14

    Rows(Ряд2).Font.ColorIndex = 11

    '

Next

    If Подробный Then

        Columns("A:A").ColumnWidth = 20

        Columns("B:B").ColumnWidth = 25

        Columns("C:C").ColumnWidth = 25

        Columns("D:D").EntireColumn.AutoFit

    Else

        Columns("A:A").ColumnWidth = 40

        Columns("B:B").ColumnWidth = 12

    End If

   

   Cells(8, 1).Select

    If Not Подробный Then

   

    For TableNum = 1 To 2 ' Сверху вниз !

   

        If TableNum = 1 Then

            ПервыйРяд = 10

            ПоследнийРяд = ПервыйРяд + _

                КолРядовБезШапки2 - 2

            ChtrNm = ReportName

        Else

            ПервыйРяд = 13 + КолРядовБезШапки2

            ПоследнийРяд = ПервыйРяд + _

                КолРядовБезШапки1 - 2

            ChtrNm = ReportName2

        End If

        '

        ChartSourceRange = "A" & CStr(ПервыйРяд) & ":B" & CStr(ПоследнийРяд)

        '

        Charts.Add

        ActiveChart.ChartType = xlPie

        ActiveChart.SetSourceData Source:= _

            Sheets("Отчеты").Range(ChartSourceRange), PlotBy _

            :=xlColumns

        ActiveChart.Location Where:=xlLocationAsObject, Name:="Отчеты"

        With ActiveChart

            .HasTitle = True

            .ChartTitle.Characters.Text = ChtrNm

        End With

        ActiveChart.HasLegend = True

        ActiveChart.Legend.Select

        Selection.Position = xlBottom

        N = ActiveSheet.Shapes.Count

        ActiveSheet.Shapes(N).ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft

        ActiveSheet.Shapes(N).IncrementLeft 210#

        If TableNum = 1 Then

            ActiveSheet.Shapes(N).IncrementTop 10#

        Else

            ActiveSheet.Shapes(N).IncrementTop 120#

        End If

       

    Next

        If Not ПлюсЕсть Then

            Worksheets("Отчеты").ChartObjects(1).Delete

        End If

        If Not МинусЕсть Then

            Worksheets("Отчеты").ChartObjects(2).Delete

        End If

   

    End If

    '

    If Not ПлюсЕсть Then

       

        Worksheets("Отчеты").Rows("9:" & CStr(ПослРяд)).Select

        Selection.EntireRow.Hidden = True 

    End If

    If Not МинусЕсть Then

        Areal = CStr(ПослРяд + 2) & ":" & CStr(РядКонечнойСуммы - 1)

        ActiveSheet.Rows(CStr(Areal)).Select

         Selection.EntireRow.Hidden = True

   End If

    '

    With ActiveSheet

        .PageSetup.PrintArea = _

          "A8:D" & CStr(РядКонечнойСуммы)

        .PageSetup.FitToPagesWide = 1

        .PageSetup.FitToPagesTall = 100

    End With

End Sub 

Лист3 Группы. Лист 4 Статьи

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.Column < 3 Then

        If Target.Row > 2 Then

            LastRow = Cells(3, 1).CurrentRegion.Rows.Count

            If Target.Row <= LastRow Then

                Cancel = True

                DialogSheets("ДиалогИзменениеГруппы").Show

            Else

                Cancel = True

                MsgBox Prompt:="Пожалуйста, не трогайте эту ячейку", Title:="ЛИЧНАЯ БУХГАЛТЕРИЯ"

            End If

        ElseIf Not ((Target.Row = 2) And (Target.Column = 2)) Then

            Cancel = True

            MsgBox Prompt:="Пожалуйста, не трогайте эту ячейку", Title:="ЛИЧНАЯ БУХГАЛТЕРИЯ"

        End If

    End If

End Sub 

' ОТЧЕТЫ

Dim ReportName As String, LiInd As Integer, ColorInd As Integer

Dim ReportName2 As String

Dim Подробный As Boolean

Dim SourceString As String

Sub DropDowns_1()

    Select Case Sheets("Отчеты").DropDowns(1).ListIndex

        Case 1 To 3

            Sheets("Отчеты").Cells(2, 1).Font.ColorIndex = 11

            Sheets("Отчеты").Cells(1, 1).Font.ColorIndex = 5

        Case 4 To 5

            Sheets("Отчеты").Cells(2, 1).Font.ColorIndex = 35

            Sheets("Отчеты").Cells(1, 1).Font.ColorIndex = 2

    End Select

 End Sub

  

Sub Temporal()

    If Sheets("Отчеты").DropDowns(2).ListIndex = 1 Then

        Подробный = True

    Else

        Подробный = False

    End If

    LiInd = Sheets("Отчеты").DropDowns(1).ListIndex

    ReportName = Trim(Sheets("Отчеты").DropDowns(1).List(LiInd))

    ColorInd = Sheets("Категории").Cells(LiInd + 1, 1).Interior.ColorIndex

    With Sheets("Temporal")

        .Cells.Delete

        .Visible = True

        .Select

        .Cells(1, 1).Select

       .Visible = False

    End With

    With Sheets("_журнал_")

 On Error GoTo AfterError

        .ShowAllData

AfterError:

        Select Case LiInd

            Case 1

                BeginPeriod = Cells(2, 1).Value

                FirstCol = 2

                LastCol = 8

                '

                ColorInd = ColorIndex = xlNone

                '

                ReportName = "Приход денег за период " _

                    & Format(Cells(2, 1).Value, "Short Date") _

                    & " - " & Format(Cells(4, 1).Value, "Short Date")

                ReportName2 = "Расход денег за период " _

                    & Format(Cells(2, 1).Value, "Short Date") _

                    & " - " & Format(Cells(4, 1).Value, "Short Date")

            Case 2

               BeginPeriod = Cells(2, 1).Value

                .Cells(5, 7).AutoFilter Field:=7, Criteria1:="Доходы"

                FirstCol = 3

                LastCol = 6

                ReportName = ReportName & " за период " _

                    & Format(Cells(2, 1).Value, "Short Date") _

                    & " - " & Format(Cells(4, 1).Value, "Short Date")

            Case 3

                BeginPeriod = Cells(2, 1).Value

                .Cells(5, 7).AutoFilter Field:=7, Criteria1:="Затраты"

                FirstCol = 3

                LastCol = 6

                ReportName = ReportName & " за период " _

                    & Format(Cells(2, 1).Value, "Short Date") _

                    & " - " & Format(Cells(4, 1).Value, "Short Date")

            Case 4

                BeginPeriod = DateSerial(1990, 1, 2)

                .Cells(5, 7).AutoFilter Field:=7, Criteria1:="Долги и займы"

                FirstCol = 2

                LastCol = 6

                ReportName = "Должники на конец даты " _

                    & Format(Cells(4, 1).Value, "Short Date")

                ReportName2 = "Займы на конец даты " _

                    & Format(Cells(4, 1).Value, "Short Date")

            Case 5

                BeginPeriod = DateSerial(1990, 1, 2)

                .Cells(5, 7).AutoFilter Field:=7, Criteria1:="Денежные накопления"

                FirstCol = 2

                LastCol = 6

                ReportName = ReportName & " на конец даты " _

                    & Format(Cells(4, 1).Value, "Short Date")

            Case Else

'                MsgBox BeginPeriod

        End Select

    End With

    With Sheets("_журнал_")

        .Cells(2, 1).Value = BeginPeriod

        .Cells(4, 1).Value = Cells(4, 1).Value

        '

        DateFilter

        '

        LastRowNumber = .Cells(5, 1).CurrentRegion.Rows.Count

        Range(.Cells(5, FirstCol), .Cells(LastRowNumber, LastCol)).Copy

    End With

    Sheets("Temporal").Paste