Tryk enter i en bestemt celle for at køre en macro!?

Indsæt denne i dit arks programkode

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$2" Then

    Range("B5").Value = "Det virker!"

End If
End Sub

Erstat

    Range("B5").Value = "Det virker!"

med din macro!

Det kræver godt nok at du foretager en ændring til celle D2.

Brug denne i stedet - den gør det du vil have!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$D$2" Then

    Range("B5").Value = "Det virker!"

End If
End Sub

Jeg tror ikke det er så enkelt at fange et tryk på Enter når der er tale om en celle.

Nej brynil det har du vist ret i.

Mit første forslag kræver at man ændre i celle D2. Det vil sige skriver noget i cellen eller trykker F2 for at rette i celle.

Mit andet forslag kræver ikke at man trykker Enter men at man blot skal markere cellen.

Der findes en funktion der kan reg. om man trykker Enter.......

tvc > Denne kan fange Enter, men hvordan man begrænser den til en enkelt celle ved jeg ikke!

' Når denne makro er kørt, køres makroen Proc hver gang der trykkes Enter.
Sub AssignKey()
  Application.OnKey "~", "'Proc'"
End Sub

' Tilbage til normal Enter opførsel
Sub ReassignKey()
  Application.OnKey "~"
End Sub

Sub Proc()
  MsgBox "Du trykkede Enter. Husk at køre ReassignKey!"
End Sub


Se hér: http://archive.baarns.com/excel/faq/xd_macr1.asp#2

Humm det virker ikke som det skal.. :S

Kan man lave en.
Hvis A1 B1 C1 =Værdi Skal den køre min macro!?

Kan du forklare mere præcist hvad det egentlig er du ønsker at foretage dig ?

Jer har et ark hvor jeg smider data i 3 celler A1:B1:C1, jeg har så lavet en macro som kopier de 3 celler og smider dem ned i række 10
hvor den der efter rykker alt fra række 10 ned en gang og går til bage til A1. det jeg gerne vil have den skal er når de 3 celler har værdi skal den automatisk køre min macro.

Hvis jeg har forstått riktig, du taster store mengder data
og vil redusere antall tastetrykk til et absolutt minimum?

Da kan det finnes andre løsninger!

Jah man skal trykke på min macro knap for at køre den og det vil jeg undgå hvis man kan gøre det par auto.. :D

Da tror jeg svaret fra tvc 21/10-2005 16:19:39 er utmerket!
Hvis du endrer Target.Address = "$D$2"  :til "$D$1"

På min norske versjon må jeg på menyen:
Verktøy -> Alternativer -> Rediger
Sette flueben for Flytt merket område etter Enter
Velg retning Høyre.

tvc skriver:
Brug denne i stedet - den gør det du vil have!
Jeg tror han har rett
Erstatt hans kode :  Range("B5").Value = "Det virker!"
Med din egen.

Når jeg i Verktøy -> Alternativer -> Rediger
Har satt flueben for Flytt merket område etter Enter
Og valgt retning Høyre.

Kan et eksempel på tvc's kode i Ark1 bli slik:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If Target.Address = "$D$1" Then
    vTmp() = Range(Cells(1, 1), Cells(1, 3))
    Rows(10).Insert shift:=xlDown
    Range(Cells(10, 1), Cells(10, 3)) = vTmp()
    Range(Cells(1, 1), Cells(1, 3)).ClearContents
    Cells(1, 1).Select
  End If
End Sub

min macro ser så dan ud.

Sub Add_vognløb()
'
' Add_vognløb Makro
'

'
    Range("C5:E5").Select
    Selection.Copy
    Range("C10").Select
    ActiveSheet.Paste
    Range("C10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F10").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=NOW()"
    Range("F10").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C10:F10").Select
    Range("F10").Activate
    Selection.Font.Bold = False
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Copy
    Sheets("Printliste").Select
    Range("A1").Select
    ActiveSheet.Paste
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown
    Range("A1").Select
    Sheets("Vognløb").Select
    Rows("10:10").Select
    Selection.Insert Shift:=xlDown
    Range("C5:E5").Select
    Range("E5").Activate
    Selection.ClearContents
    Range("C5").Select
    ActiveWorkbook.Save
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If Target.Address = "$D$1" Then
  Add_vognløb
  End If
End Sub

Rettelse
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If Target.Address = "$D$1" Then
  Call Add_vognløb
  End If
End Sub

Det var lige det som jeg skulle bruge... mange tak....

Du kan evt. gøre din makrokørsel afhængig af om de 3 celler er udfyldt. Her et ex. med udgangspunkt i din kommentar 23/10-2005 15:01:06...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tmp()
    If Range("A1").Value <> "" And Range("B1").Value <> "" And Range("C1").Value <> "" Then
        tmp() = Range(Cells(1, 1), Cells(1, 3))
        Range(Cells(1, 1), Cells(1, 3)).Value = ""
        If Range("A10").Value = "" Then
            Range(Cells(10, 1), Cells(10, 3)) = tmp()
            Range("A1").Select
        Else
            Rows(10).Insert shift:=xlDown
            Range(Cells(10, 1), Cells(10, 3)) = tmp()
            Range("A1").Select
        End If
    End If
End Sub

ja nå er det mange muligheter:
Hvis du ikke ønser å tenke på innstillingene i excel,
kan du skrive denne koden i modulet til ThisWorkbook:



'** DENNE KOEN KAN STÅ I ThisWorkbook modulen
Private Sub Workbook_Open()
  '** ETTER ENTER FLYTTES AKTIV CELLE TIL HØYRE
  Application.MoveAfterReturn = True
  Application.MoveAfterReturnDirection = xlToRight
End Sub

som brynil skriver kan man teste at alle 3 celler er utfylt.
koden kan stå i modluen til ditt sheet(vognløb)
Den kan også se slik ut:

'** DENNE KODE MÅ STÅ I SHEET("Vognløb")
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
  If Target.Address = Cells(5, 6).Address Then
       
    '*** MAN KOMMER IKKE VIDERE FØR ALLE 3 CELLER ER FYLT UT
    For Each c In Range(Cells(5, 3), Cells(5, 5))
      If IsEmpty(c) Then Cells(5, 3).Select: Exit Sub
    Next
   
    Cells(5, 6).FormulaR1C1 = "=now()"
    Call Add_vognløb
  End If
End Sub

til sist har jeg tatt en titt på din egen kode,
tor den også kan skrives slik:

Sub Add_vognløb()
   
  Rows(10).Insert
  With Range(Cells(10, 3), Cells(10, 6))
    .Value = .Offset(-5).Value
    .Offset(-5).ClearContents
    .HorizontalAlignment = xlCenter 'hvis man ønsker
    With .Font
    .Bold = False
    .Name = "Arial"
    .Size = 10
    End With
    .Copy
  End With
 
  Sheets("PrintListe").Select
  Range(Cells(1, 1), Cells(1, 4)).PasteSpecial xlPasteAll
  Rows(1).Insert
 
  Sheets("Vognløb").Select
  Cells(5, 3).Select
  ActiveWorkbook.Save
End Sub

Ser at dine data kommer likt i to forskejllige sheets
Hvis det ikke er nødvendig, kan du bytte ut siset kode med denne:

Sub Add_vognløb()
   
  Dim vDb() As Variant
  vDb() = Range(Cells(5, 3), Cells(5, 6))
  Range(Cells(5, 3), Cells(5, 6)).ClearContents
 
  Sheets("PrintListe").Select
  With Sheets("PrintListe").Range(Cells(1, 1), Cells(1, 4))
      .Value = vDb
      .HorizontalAlignment = xlCenter 'hvis man ønsker
      With .Font
      .Bold = False
      .Name = "Arial"
      .Size = 10
      End With
      .Rows(1).Insert
  End With
 
  Sheets("Vognløb").Select
  Cells(5, 3).Select
  ActiveWorkbook.Save
 
End Sub

koden i Private Sub Workbook_Open() vil kun bli utført når excelboken
blir åpnet, den må derfor lagres, lukkes og så åpnes igjen før blir utført

Oki men det skal ud på to sheets for ikke at lave for meget i vognløb!!

Ellers mange tak....... Splokit Out