Lokal brugermenu

Option Explicit

Sub Auto_Open()
'  Creates a new menu and adds menu items
    Dim Cap(1 To 5)
    Dim Mac(1 To 5)
    Dim MenuName As String
   
    MenuName = "&Dennisas_Menu"
   
    Cap(1) = "Celle Ark1 A1 =10"
    Mac(1) = "mac1"
    Cap(2) = "Celle Ark1 A2 =20"
    Mac(2) = "mac2"
    Cap(3) = "Celle Ark1 A1 input"
    Mac(3) = "mac3"
    Cap(4) = "Celle Ark1 A2 input"
    Mac(4) = "mac4"
    Cap(5) = "Active celle = Ark3 celle A1"
    Mac(5) = "mac5"
   
    On Error Resume Next
'  Delete the menu if it already exists
    MenuBars(xlWorksheet).Menus(MenuName).Delete
   
'  Add the menu
    MenuBars(xlWorksheet).Menus.Add Caption:=MenuName, before:="Help"
   
'  Add the menu items
    With MenuBars(xlWorksheet).Menus(MenuName).MenuItems
   
        .Add Caption:=Cap(1), OnAction:=Mac(1)
        .Add Caption:=Cap(2), OnAction:=Mac(2)
        .Add Caption:="-"
        .Add Caption:=Cap(3), OnAction:=Mac(3)
        .Add Caption:=Cap(4), OnAction:=Mac(4)
        .Add Caption:="-"
        .Add Caption:=Cap(5), OnAction:=Mac(5)
       
    End With
End Sub

Sub Auto_Close()
    Dim MenuName As String
    MenuName = "&Min_Menu"
'  Delete the menu before closing
    On Error Resume Next
    MenuBars(xlWorksheet).Menus(MenuName).Delete
End Sub

Sub mac1()
Sheets(1).Range("A1").Value = 10
MsgBox "Test A1 er nu =10"
End Sub

Sub mac2()
Sheets(1).Range("A2").Value = 20
MsgBox "Test A2 er nu =20"
End Sub
Sub mac3()
    Dim Svar As String
    Svar = InputBox("Ændre A1 =" & Sheets(1).Range("A1") & " til værdi?")
    Sheets(1).Range("A1").Value = Svar
    MsgBox "Test A1 er nu = " & Svar & "."
End Sub

Sub mac4()
    Dim Svar As String
    Svar = InputBox("Ændre A2 =" & Sheets(1).Range("A2") & " til værdi?")
    MsgBox "Test A2 er nu = " & Svar & "."
    Sheets(1).Range("A2").Value = Svar
End Sub

Sub mac5()
ActiveCell.Value = Sheets(3).Range("A1").Value
End Sub

Option Explicit

Sub Auto_Open()
'  Creates a new menu and adds menu items
    Dim Cap(1 To 7)
    Dim Mac(1 To 7)
    Dim MenuName As String
   
    MenuName = "&Dennisas_Menu"
   
    Cap(1) = "Indsæt værdien " & Sheets(3).Range("A1") & " i celle A1"
    Mac(1) = "mac1"
    Cap(2) = "Indsæt værdien " & Sheets(3).Range("A2") & " i celle A1"
    Mac(2) = "mac2"
    Cap(3) = "Indsæt værdien " & Sheets(3).Range("B1") & " i celle A2"
    Mac(3) = "mac3"
    Cap(4) = "Indsæt værdien " & Sheets(3).Range("B2") & " i celle A2"
    Mac(4) = "mac4"
    Cap(5) = "Celle Ark1 A1 input"
    Mac(5) = "mac5"
    Cap(6) = "Celle Ark1 A2 input"
    Mac(6) = "mac6"
    Cap(7) = "Active celle = Ark3 celle A1: " & Sheets(3).Range("A1")
    Mac(7) = "mac7"
   
    On Error Resume Next
'  Delete the menu if it already exists
    MenuBars(xlWorksheet).Menus(MenuName).Delete
   
'  Add the menu
    MenuBars(xlWorksheet).Menus.Add Caption:=MenuName, before:="Help"
   
'  Add the menu items
    With MenuBars(xlWorksheet).Menus(MenuName).MenuItems
   
        .Add Caption:=Cap(1), OnAction:=Mac(1)
        .Add Caption:=Cap(2), OnAction:=Mac(2)
        .Add Caption:="-"
        .Add Caption:=Cap(3), OnAction:=Mac(3)
        .Add Caption:=Cap(4), OnAction:=Mac(4)
        .Add Caption:="-"
        .Add Caption:=Cap(5), OnAction:=Mac(5)
        .Add Caption:=Cap(6), OnAction:=Mac(6)
        .Add Caption:="-"
        .Add Caption:=Cap(7), OnAction:=Mac(7)
       
    End With
End Sub

Sub Auto_Close()
    Dim MenuName As String
    MenuName = "&Dennisas_Menu"
'  Delete the menu before closing
    On Error Resume Next
    MenuBars(xlWorksheet).Menus(MenuName).Delete
End Sub

Sub mac1()
Dim Før
Dim Svar As Integer
Før = Sheets(1).Range("A1").Value

Sheets(1).Range("A1").Value = Sheets(3).Range("A1")
Svar = MsgBox("Du er ved at ændret A1" & vbCrLf & _
"fra:" & vbTab & Før & vbCrLf & _
"til:" & vbTab & Sheets(3).Range("A1"), vbOKCancel, "Advarsel...")

If Svar = vbCancel Then    ' User chose Cancel.
Sheets(1).Range("A1").Value = Før
ElseIf Svar = vbOK Then    ' User chose OK.
Exit Sub
End If
End Sub

Sub mac2()
Sheets(1).Range("A1").Value = Sheets(3).Range("A2")
MsgBox "A1 er nu =" & Sheets(3).Range("A2")
End Sub

Sub mac3()
Sheets(1).Range("A2").Value = Sheets(3).Range("B1")
MsgBox "A2 er nu =" & Sheets(3).Range("B1")
End Sub

Sub mac4()
Sheets(1).Range("A2").Value = Sheets(3).Range("B2")
MsgBox "A2 er nu =" & Sheets(3).Range("B2")
End Sub

Sub mac5()
    Dim Svar As String
    Svar = InputBox("Ændre A1 =" & Sheets(1).Range("A1") & " til værdi?")
    Sheets(1).Range("A1").Value = Svar
    MsgBox "A1 er nu = " & Svar & "."
End Sub

Sub mac6()
    Dim Svar As String
    Svar = InputBox("Ændre A2 =" & Sheets(1).Range("A2") & " til værdi?")
    MsgBox "A2 er nu = " & Svar & "."
    Sheets(1).Range("A2").Value = Svar
End Sub

Sub mac7()
Dim Før
Dim Svar As Integer
Før = ActiveCell.Value

ActiveCell.Value = Sheets(3).Range("A1").Value
Svar = MsgBox("Du er ved at ændret den active celle" & vbCrLf & _
"fra:" & vbTab & Før & vbCrLf & _
"til:" & vbTab & Sheets(3).Range("A1"), vbOKCancel, "Advarsel...")

If Svar = vbCancel Then    ' User chose Cancel.
ActiveCell.Value = Før
ElseIf Svar = vbOK Then    ' User chose OK.
Exit Sub
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Intersect(Range("A1:B2"), Target) Is Nothing Then
        Auto_Open
    End If
End Sub