Har du set hvor smart det kan være?

• Word - Smart Office Skabelon system
• Word - Søg og erstat i flere dokumenter
• Excel - File Export
• Excel - Data Management (Freeware)

SmartOffice - JumpCells

Private Sub Worksheet_Change(ByVal Target As Range)
'Flemming Vadet, December 2001, fv@smartoffice.dk
    Dim rJumpCells As Range
    Dim lNumberOfStartCells As Long
    Dim iCount As Long

    Set rJumpCells = Range("g2,g4,g6,g8,c11,c13,i2,i9,g20,j20,l20,b24,c24")
    lNumberOfStartCells = 1

    If Not Intersect(Target, rJumpCells) Is Nothing Then
        For iCount = 1 To rJumpCells.Areas.Count - lNumberOfStartCells
            If Not Intersect(Target, rJumpCells.Areas(iCount)) Is Nothing Then
                rJumpCells.Areas(iCount + lNumberOfStartCells).Activate
                Exit For
            End If
        Next iCount
    End If

    Set rJumpCells = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Flemming Dahl, december 2001, fd@smartoffice.dk
    Dim rJumper As Range
    Dim rJumpCells1 As Range
    Dim rJumpCells2 As Range
    Dim bJump1 As Boolean
    Dim bJump2 As Boolean
    Dim lNumberOfStartCells As Long
    Dim iCount As Long

    'NOTER dig at sidste celle i rJumpCells1 er den samme celle som
    'første celle i rJumpCells2
    'MAX længde af JumpCells' Range er 255 karakter, så ingen unødige
    'mellemrum i definationen af Range("... ...")
    'Er du i tvivl om længden, så paste a1,A2....i8,i9 ind i en celle og
    'lad en anden celle tælle =LÆNGDE(xx)
    Set rJumpCells1 = Range("D5,D7,D10,D11,D12,D15,D17,D19,H5,H6,H7,H13")
    Set rJumpCells2 = Range("H13,L23,K23,M24,L24,K24,M27,K27,M28,K28,M29")
    lNumberOfStartCells = 1

    If Not Intersect(Target, rJumpCells1) Is Nothing Then
        bJump1 = True
        Set rJumper = rJumpCells1
    End If
    
    If Not Intersect(Target, rJumpCells2) Is Nothing Then
        bJump2 = True
        Set rJumper = rJumpCells2
    End If
    
    'Hopper løs
    If bJump1 Or bJump2 Then
        For iCount = 1 To rJumper.Areas.Count - lNumberOfStartCells
            If Not Intersect(Target, rJumper.Areas(iCount)) Is Nothing Then
                rJumper.Areas(iCount + lNumberOfStartCells).Activate
                Exit For
            End If
        Next iCount
    End If
    
    Set rJumper = Nothing
    Set rJumpCells1 = Nothing
    Set rJumpCells2 = Nothing
End Sub