Autosum i en celle via makro

Hej quark,

Prøv denne kode.
Jeg har lagt en lille spærriing ind, så koden kun indsætter en sum, hvis feltet er formateret til BOLD. Du kan selv vælge en anden metode, hvis du bedre kan li' dette. Jeg vil dog råde dig til at lave denne test, da du - eller din bruger - ellers vil komme til at lægge en sum oven i et forkert sted.

Sub BeregnSum()

Dim TempSum As Double
Dim iRække As Integer
Dim iKolonne As Integer
Dim x As Variant

'hvis formatet IKKE er FED(Bold), så forlades makroen
If ActiveCell.Font.Bold = False Then
    MsgBox "Du står ikke i en celle, med formatet FED"
    Exit Sub
End If

UBeskytArk

'sæt variablerne til aktuelle udgangspunkt
    iRække = ActiveCell.Row - 1
    iKolonne = ActiveCell.Column
    TempSum = 0
   
'for hver celle målt fra cellen lige over udgangspunktet til der mødes en celle med tekst eller værdien NUL
    Do Until iRække = 0
   
        If IsNumeric(Cells(iRække, iKolonne).Value) = True And Val(Cells(iRække, iKolonne).Value) <> 0 Then
            TempSum = TempSum + Cells(iRække, iKolonne).Value
        Else
            Exit Do
        End If
       
        iRække = iRække - 1
    Loop

   
    Selection.Value = TempSum


BeskytArk

End Sub

Sub BeskytArk()
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="1234"
End Sub


Sub UBeskytArk()
    ActiveSheet.Unprotect Password:="1234"
End Sub

Hej ExcelKen

Det ser rigtig godt ud, jeg har dog slået den lille spæring fra, da det ikke er muligt at formateret til BOLD, når arket er skrivebeskyttet, heller ikke i de celler som er uden lås. (bruger excel 2003, ved ikke om det er muligt i 2007)

Men det virker rigtig godt, mange tak for hjælpen, du bliver tildelt point :-)

Quark

Hej ExcelKen

Det ser rigtig godt ud, jeg har dog slået den lille spæring fra, da det ikke er muligt at formateret til BOLD, når arket er skrivebeskyttet, heller ikke i de celler som er uden lås. (bruger excel 2003, ved ikke om det er muligt i 2007)

Men det virker rigtig godt, mange tak for hjælpen, du bliver tildelt point :-)

Quark