Point til supertekst

Tillæg til spørgsmål http://www.eksperten.dk/spm/686172

Dette er løsningen hvor der også er lagt følgende 3. funktioner ind:

1. Mulighed for at bestemme antallet af budgetposter der skal overføres (styres via Data sheet).

2. Mulighed for at sammenligne alle ark i de to filer (regnskab og Budget).

3. Mulighed for at styre filnavn for budget via Data sheet.

Den endelige løsning:

Dim filSti
Dim måned, bFil As Object, budget, rBudKol, rTabel(), bTabel(), antalBceller, filFejlFlag As Boolean
Dim budgetFilNavn As String
Const arkNot = "ConsolidatedTotalEnd"
Private Sub hentfilSti()
    filSti = ActiveWorkbook.Path
    If Right(filSti, 1) <> "\" Then
        filSti = filSti + "\"                      'tilføjer evt. \
    End If
End Sub
Sub worksheet_change(ByVal target As Excel.Range)  'aflæser måned ved ændring
    If Not Intersect(target, Range("D1")) Is Nothing Then

Rem Hent kolonne, hvor budget skal indsættes i Regnskab
        rBudKol = Asc(UCase(Cells(6, 2))) - 64
       
Rem Antal celler for opdatering af budgettal
        antalBceller = Cells(3, 2)
       
        ReDim rTabel(antalBceller)
        ReDim bTabel(antalBceller)
       
Rem Opret tabeller vedr budgettal - begynder i kolonne B
        For f = 2 To antalBceller + 1
            rTabel(f - 2) = Cells(4, f)
            bTabel(f - 2) = Cells(5, f)
        Next f

Rem Hent navn på budgetfil
        budgetFilNavn = Cells(8, 2)
       
Rem Hent aktuelle sti
        hentfilSti
       
Rem Optæl budget indtil måned
        måned = Cells(1, 4)
       
        If IsNumeric(måned) = True And måned >= 1 And måned <= 12 Then
            åbnBudget
           
            If filFejlFlag = True Then
                MsgBox ("Budgetfil: " + budgetFilNavn + " kan ikke åbnes")
                Exit Sub
            End If
        Else
            MsgBox ("Valgte måned ikke korrekt!")
            Cells(1, 4).Activate
        End If
    End If
End Sub
Private Sub åbnBudget()
Dim ark, arknavn, række, kolonne, budgetSum
    On Error GoTo filfejl
   
    Set bFil = CreateObject("Excel.application")
    With bFil
        .Visible = True
        .Workbooks.Open (filSti + budgetFilNavn)
       
Rem behandling af hvert ark i budget
        For Each ark In .ActiveWorkbook.Sheets
            arknavn = ark.Name
           
Rem Test om det et relevant ark
            If InStr(arkNot, arknavn) = 0 Then
                .ActiveWorkbook.Sheets(arknavn).Activate
               
                For række = 1 To antalBceller
                    budgetSum = 0
                    For kolonne = 2 To måned + 1
                        budgetSum = budgetSum + .Cells(bTabel(række - 1), kolonne)
                    Next kolonne
Rem indsæt rækketotal i regnskab i kolonne 15 (årsbudget)
                    ActiveWorkbook.Sheets(arknavn).Cells(rTabel(række - 1), rBudKol) = budgetSum
                Next række
            End If
        Next ark
    End With
    bFil.Quit
    Set bFil = Nothing
    filFejlFlag = False
    Exit Sub
   
filfejl:
    filFejlFlag = True
    Set bFil = Nothing
End Sub