Option Explicit

'
' Globale
'

Dim wkbCalcule As Excel.Workbook
Dim blnCaietExistent As Boolean

Public Sub CreareCaiet()
    Dim intNrFoi As Integer
    '
    ' Se memoreaza numarul de foi dintr-un caiet (workbook) nou
    ' (setare generala Excel)
    '
    intNrFoi = Application.SheetsInNewWorkbook
    '
    ' Se verifica existenta un caiet cu numele Calcule.xls
    '
    VerificareCaiet
    '
    ' Daca nu, este creat un caiet nou, care se salveaza cu numele Calcule.xls
    '
    If blnCaietExistent Then    'Caietul Calcule.xls este deschis
        MsgBox "Caietul ""Calcule"" exista", vbOKOnly, "Verificare"
    Else
        '
        ' Se deschide un nou caiet, cu o singura foaie
        '
        Application.SheetsInNewWorkbook = 1
        Set wkbCalcule = Application.Workbooks.Add 'creere
        '
        ' Se restaureaza numarul de foi dintr-un caiet nou
        ' (la valoarea memorata anterior)
        '
        Application.SheetsInNewWorkbook = intNrFoi
        wkbCalcule.SaveAs fileName:="Calcule.xls"   ' caietul se salveaza cu numele Calcule.xls .Save se poate doar dupa SaveAs
        '
        ' Se modifica numele foii de calcul
        '
        wkbCalcule.Worksheets(1).Name = "Calcule"
        MsgBox "S-a creat caietul ""Calcule""", vbOKOnly, "Verificare"
    End If
    '
    ' Se activeaza primul caiet deschis (focus)
    '
    Workbooks(1).Activate
    '
    ' Se apeleaza procedura de organizare a caietului
    '
    OrganizareCaiet
End Sub

Private Sub OrganizareCaiet()
    Dim intIndex As Integer, intIndexCol As Integer, intLinii As Integer, intColoane As Integer
    Dim wkbActiv As Excel.Workbook
    Dim rngTitlu As Excel.Range, rngDate As Excel.Range, rngSursa As Excel.Range
    '
    ' Se memoreaza caietul activ
    '
    Set wkbActiv = ActiveWorkbook
    If wkbActiv Is wkbCalcule Then 'Compara referinte
        MsgBox "Activati un caiet diferit de caietul Calcule"
        Exit Sub    ' Daca procedura se initiaza dintr-un caiet diferit de Calcule.xls
    End If
    '
    ' Se memoreaza regiunea curenta din caietul sursa
    '
    Set rngSursa = wkbActiv.Worksheets(1).Range("A1").CurrentRegion 'CurrentRegion se refera la un dreptunghi minimal, dar sa fie conexe celulele
    intLinii = rngSursa.Rows.Count  ' Numarul de linii din sursa
    intColoane = rngSursa.Columns.Count ' Numarul de coloane din sursa

    wkbCalcule.Activate
    wkbCalcule.Worksheets(1).UsedRange.Delete   ' se elimina datele existente in Calcule.xls
    '
    ' Completarea informatiilor in zona destinatie
    '
    ' Titlul
    '
    Set rngTitlu = Range("A1")
    With rngTitlu
        .Value = "Lista"
        .Font.Name = "Arial"
        .Font.Bold = True
        .Font.Size = 16
        .HorizontalAlignment = xlCenter
    End With
    Range("A1:C1").Merge (True)
    Set rngDate = Range(Cells(3, 1).Address, Cells(intLinii + 3, 1 + intColoane).Address)
    '
    ' Linia de antet
    '
    With rngDate
        .Interior.Color = vbBlue
        .Cells(1, 1) = "Nr.crt."
        .Cells(1, 2) = "Denumire"
        .Cells(1, 3) = "Valoare"
        .Cells(1, 4) = "Altele"
        .Rows(1).Interior.Color = vbGreen
        '
        ' Copierea informatiilor din sursa
        '
        For intIndex = 1 To intLinii
            .Cells(intIndex + 1, 1) = intIndex
            For intIndexCol = 1 To intColoane
                .Cells(intIndex + 1, intIndexCol + 1) = rngSursa.Cells(intIndex, intIndexCol)
            Next intIndexCol
        Next intIndex
        '
        ' Completarea cu linia de total
        '
        .Cells(intLinii + 2, 2) = "Total"
        For intIndexCol = 2 To intColoane
            .Cells(intLinii + 2, intIndexCol + 1).Formula = "=SUM(" & .Cells(2, intIndexCol + 1).Address & _
            ":" & .Cells(intLinii + 1, intIndexCol + 1).Address & ")"
        Next intIndexCol

        .Rows(intLinii + 2).Interior.Color = vbYellow
        .Columns(1).Interior.Color = vbYellow
    End With

    wkbActiv.Activate   ' Se activeaza caietul initial
End Sub

Private Sub VerificareCaiet()
    Dim wkbCaiet As Workbook
    Dim filName As Variant ' orice tip de var
    '
    ' Se verifica existenta unui caiet deschis cu numele Calcule.xls
    '
    blnCaietExistent = False

    For Each wkbCaiet In Application.Workbooks
        If wkbCaiet.Name = "Calcule.xls" Then
            blnCaietExistent = True
            Set wkbCalcule = wkbCaiet
        End If
    Next
    '
    ' Se verifica existenta unui caiet salvat cu numele Calcule.xls
    ' in directorul curent
    '
    ' DEPRECATED
    'If Not blnCaietExistent Then
    '    With Application.FileSearch
    '        .NewSearch
    '        .fileName = "Calcule.xls"
    '        .MatchTextExactly = True
    '    End With
    '
    '    If Application.FileSearch.Execute() > 0 Then ' exista caietul Calcule.xls
    '        Workbooks.Open "Calcule.xls"    ' se deschide caietul. Il face automat activ, fata de cum face add.
    '        Worksheets(1).UsedRange.Delete  ' se elimina informatia existenta. UsedRange e un dreptunghi minim din ala cu A3:C5 care contine toate informatiile din xls
    '        blnCaietExistent = True
    '        Set wkbCalcule = Workbooks("Calcule.xls")
    '    End If
    'End If
    If Len(Dir("Calcule.xls")) > 0 Then
        Workbooks.Open ("Calcule.xls")
        Worksheets(1).UsedRange.Delete
        blnCaietExistent = True
        Set wkbCalcule = Workbooks("Calcule.xls")
    End If
End Sub