[gelöst] Makro ausführen nach Zelleingabe

Programmierung unter AOO/LO (StarBasic, Python, Java, ...)

Moderator: Moderatoren

Antworten
mumpel
****
Beiträge: 133
Registriert: So, 22.08.2004 05:27
Wohnort: Lindau (B)
Kontaktdaten:
Kontaktdaten von mumpel

[gelöst] Makro ausführen nach Zelleingabe

Beitrag von mumpel »

Hallo!

Kann man ein Makro nach eingabe in eine Zelle auslösen. Hier das Pentant aus Excel.

Code: Alles auswählen

Private Sub worksheet_change(ByVal target As Range)
On Error GoTo Ende
If target.Address = "$F$4" Then Call Aendern
Ende:
End Sub
Hier die Makros, welche ausgelöst werden sollen.
Funktionsweise: Zuerst werden anhand der Feiertagsliste und der Sonntage/Samstage selbige entsprechend eingefärbt. Anschließend wird in Spalte W ein F eingetragen (wird für weitere Berechnungen benötigt).

Code: Alles auswählen

Sub Aendern()
Application.EnableCancelKey = xlDisabled
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Zeitnachweis").Unprotect passw
Week_end
Week_day
Week_frei
Week_end2
Week_day2
Sheets("Zeitnachweis").Protect passw
Application.ScreenUpdating = True
End Sub

Private Sub Week_end()
Application.EnableCancelKey = xlDisabled
Dim cell As Object
On Error Resume Next
Dim Zeile As Range
For Each cell In Worksheets("Zeitnachweis").Range("B13:B743")
If Weekday(cell, vbMonday) = 7 Then
cell.Font.ColorIndex = 3
ElseIf Weekday(cell, vbMonday) = 6 Then
cell.Font.ColorIndex = 5
Else
cell.Font.ColorIndex = 0
End If
Next cell
End Sub

Private Sub Week_end2()
Application.EnableCancelKey = xlDisabled
Dim cell As Object
On Error Resume Next
Dim Zeile As Range
For Each cell In Worksheets("Zeitnachweis").Range("AB13:AB743")
If Weekday(cell, vbMonday) = 7 Then
cell.Font.ColorIndex = 3
ElseIf Weekday(cell, vbMonday) = 6 Then
cell.Font.ColorIndex = 5
Else
cell.Font.ColorIndex = 0
End If
Next cell
End Sub

Private Sub Week_day()
Application.EnableCancelKey = xlDisabled
Dim cell As Object
On Error Resume Next
Dim Zeile As Range
For Each cell In Worksheets("Zeitnachweis").Range("B13:B743")
If cell.value = Sheets("Feiertage").Range("A1").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A2").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A3").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A4").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A5").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A6").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A7").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A8").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A9").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A10").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A11").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A12").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A13").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A14").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A15").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A16").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A17").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A18").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A19").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A20").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A21").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A22").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A23").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A24").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A25").value Then
cell.Font.ColorIndex = 3
Else
End If
Next cell
End Sub

Private Sub Week_day2()
Application.EnableCancelKey = xlDisabled
Dim cell As Object
On Error Resume Next
Dim Zeile As Range
For Each cell In Worksheets("Zeitnachweis").Range("AB13:AB743")
If cell.value = Sheets("Feiertage").Range("A1").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A2").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A3").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A4").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A5").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A6").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A7").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A8").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A9").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A10").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A11").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A12").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A13").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A14").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A15").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A16").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A17").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A18").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A19").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A20").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A21").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A22").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A23").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A24").value Then
cell.Font.ColorIndex = 3
ElseIf cell.value = Sheets("Feiertage").Range("A25").value Then
cell.Font.ColorIndex = 3
Else
End If
Next cell
End Sub

Private Sub Week_frei()
Application.EnableCancelKey = xlDisabled
Dim cell As Object
On Error Resume Next
Dim Zeile As Range
For Each cell In Worksheets("Zeitnachweis").Range("B13:B743")
If cell.value = Sheets("Feiertage").Range("A1").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A2").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A3").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A4").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A5").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A6").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A7").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A8").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A9").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A10").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A11").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A12").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A13").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A14").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A15").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A16").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A17").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A18").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A19").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A20").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A21").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A22").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A23").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A24").value Then
cell.Offset(0, 21).value = "F"
ElseIf cell.value = Sheets("Feiertage").Range("A25").value Then
cell.Offset(0, 21).value = "F"
Else
cell.Offset(0, 21).value = ""
End If
Next cell
End Sub
Danke!

Gruß, René
Zuletzt geändert von mumpel am Do, 31.07.2008 20:22, insgesamt 1-mal geändert.

Windows 7 Home Premium (auf Acer Desktop PC)
Windows 8 Professional (auf Microsoft Surface Pro 3).
MSO 365 Home Premium
LibreOffice 4.2.
F-Secure Internet Security
Nach oben
Benutzeravatar
komma4
********
Beiträge: 5332
Registriert: Mi, 03.05.2006 23:29
Wohnort: Chon Buri Thailand Asia
Kontaktdaten:
Kontaktdaten von komma4

Re: Makro ausführen nach Zelleingabe

Beitrag von komma4 »

Du findest bei mir auf der Webseite Code-Beispiele für Calc.

Beispiel für event-Listener
Das ist bei OOo nicht trivial.


Beispiel für Calc-Zellhintergrund

Code: Alles auswählen

lEvenColor = RGB(255,200,200)
lOddColor = RGB(188,188,188) 
'[...]
' actRange ist ein zuvor definierter Bereich, Zelle geht auch
actRange.setPropertyValue("CellBackColor", lOddColor)

Viel Erfolg!
Cheers
Winfried
aktuell: LO 5.3.5.2 30m0(Build:2) SUSE rpm, unter Linux openSuSE Leap 42.3 x86_64/KDE5
DateTime2 Einfügen von Datum/Zeit/Zeitstempel (als OOo Extension)
Nach oben
turtle47
*******
Beiträge: 1849
Registriert: Mi, 04.01.2006 20:10
Wohnort: Rheinbach

Re: Makro ausführen nach Zelleingabe

Beitrag von turtle47 »

wenn A1 die Zelle ist in der der Wert der Null werden soll überwacht werden soll. Sobald A1 0 wird wird automatisch die gewünschte Email gesendet.
Beispiel Zellwert.
Software hat keinen Verstand - benutze deinen eigenen...!

Win 7 SP1/ LibreOffice 3.4.2 OOO340m1 (Build:203) / Firefox 15.0.1 / Notebook ASUS K70IO 64 Bit-Betriebssytem
Nach oben
mumpel
****
Beiträge: 133
Registriert: So, 22.08.2004 05:27
Wohnort: Lindau (B)
Kontaktdaten:
Kontaktdaten von mumpel

Re: Makro ausführen nach Zelleingabe

Beitrag von mumpel »

Danke, so kann man es auch machen. Im Test funktioniert es.

Windows 7 Home Premium (auf Acer Desktop PC)
Windows 8 Professional (auf Microsoft Surface Pro 3).
MSO 365 Home Premium
LibreOffice 4.2.
F-Secure Internet Security
Nach oben
Antworten

Zurück zu „Makros und allgemeine Programmierung“