LibreOffice-Forum

Das Online-Forum rund um das LibreOffice Softwarepaket
https://www.libreoffice-forum.de/

LibreOffice Basic, wer kann VBA Excel code anpassen auf Calc

https://www.libreoffice-forum.de/viewtopic.php?f=12&t=12418

Seite 1 von 1

LibreOffice Basic, wer kann VBA Excel code anpassen auf Calc

Verfasst: Fr 6. Sep 2013, 00:09
von th.giese
Ich habe hir ein Tabellen Dokument, in das unter Excel folgender Code eingebunden ist:

Code: Alles auswählen

Rem Attribute VBA_ModuleType=VBADocumentModule
Option VBASupport 1
Option Explicit
Private Sub Worksheet_Activate()

    If Worksheets("Deckblatt").CheckBox2 = True Then
    Range("BI10").Value = "Dan"
    Else
    Range("BI10").Value = "Kyu"
    End If
    ActiveSheet.Unprotect ("Prüfung_jjvb")

        On Error Resume Next
    If Range("BI10").Value = "Dan" Then
        Range("I6:I25").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$BG$17:$BG$22"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = "Derzeitige Graduierung"
            .ErrorTitle = "Derzeitige Graduierung"
            .InputMessage = "Bitte die derzeitige Graduierung aus der Liste wählen." & Chr(10) & "" & Chr(10) & "A c h t u n g :" & Chr(10) & "Nachträgliche Änderungen führen zu Fehlern!"
            .ErrorMessage = " " & Chr(10) & "Der vorgenommene Eintrag ist für" & Chr(10) & "diese Prüfung nicht vorgesehen." & Chr(10) & "" & Chr(10) & "Bitte wählen Sie die" & Chr(10) & "derzeitige Graduierung aus der Liste." & Chr(10)
            .ShowInput = True
            .ShowError = True
        End With
    Else
        Range("I6:I25").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$BG$6:$BG$16"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = "Derzeitige Graduierung"
            .ErrorTitle = "Derzeitige Graduierung"
            .InputMessage = "Bitte die derzeitige Graduierung aus der Liste wählen." & Chr(10) & "" & Chr(10) & "A c h t u n g :" & Chr(10) & "Nachträgliche Änderungen führen zu Fehlern!"
            .ErrorMessage = " " & Chr(10) & "Der vorgenommene Eintrag ist für" & Chr(10) & "diese Prüfung nicht vorgesehen." & Chr(10) & "" & Chr(10) & "Bitte wählen Sie die" & Chr(10) & "derzeitige Graduierung aus der Liste." & Chr(10)
            .ShowInput = True
            .ShowError = True
        End With
    End If


    Dim Target As Range

    Dim inZeile As Integer
    ActiveSheet.Unprotect ("Prüfung_jjvb")
    For inZeile = 6 To 25
    If Cells(inZeile, 10) = "X" Then Cells(inZeile, 10).Locked = True
    Next inZeile

   Me.Range("AG6:AJ25").Locked = True               'Diese Bereiche beim Aktivieren auch noch sperren
   Me.Range("AM6:AM25").Locked = True
   Me.Range("A1:AO5").Locked = True
   Me.Range("A6:A25").Locked = True
   Me.Range("A26:AO36").Locked = True

    ActiveSheet.Protect '("Prüfung_jjvb")          'Hier wird der Blattschutz mit Kennwort aktiviert.
    Application.DisplayFormulaBar = False           'Die Bearbeitungsleiste wird ausgeblendet
    Range("C6").Select

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

'Merken der aktuellen Zelle
Dim rngOld As Range
Set rngOld = ActiveCell

    If Range("I6") = "6. Kyu" And Range("B6") = "x" Or Range("I6") = "6.1 Kyu" And Range("B6") = "x" Or Range("I6") = "5. Kyu" And Range("B6") = "x" Or Range("I6") = "5.1 Kyu" And Range("B6") = "x" Then
    Call Zeile6
    End If
    
    If Range("I7") = "6. Kyu" And Range("B7") = "x" Or Range("I7") = "6.1 Kyu" And Range("B7") = "x" Or Range("I7") = "5. Kyu" And Range("B7") = "x" Or Range("I7") = "5.1 Kyu" And Range("B7") = "x" Then
    Call Zeile7
    End If
    
    If Range("I8") = "6. Kyu" And Range("B8") = "x" Or Range("I8") = "6.1 Kyu" And Range("B8") = "x" Or Range("I8") = "5. Kyu" And Range("B8") = "x" Or Range("I8") = "5.1 Kyu" And Range("B8") = "x" Then
    Call Zeile8
    End If

    If Range("I9") = "6. Kyu" And Range("B9") = "x" Or Range("I9") = "6.1 Kyu" And Range("B9") = "x" Or Range("I9") = "5. Kyu" And Range("B9") = "x" Or Range("I9") = "5.1 Kyu" And Range("B9") = "x" Then
    Call Zeile9
    End If

    If Range("I10") = "6. Kyu" And Range("B10") = "x" Or Range("I10") = "6.1 Kyu" And Range("B10") = "x" Or Range("I10") = "5. Kyu" And Range("B10") = "x" Or Range("I10") = "5.1 Kyu" And Range("B10") = "x" Then
    Call Zeile10
    End If

    If Range("I11") = "6. Kyu" And Range("B11") = "x" Or Range("I11") = "6.1 Kyu" And Range("B11") = "x" Or Range("I11") = "5. Kyu" And Range("B11") = "x" Or Range("I11") = "5.1 Kyu" And Range("B11") = "x" Then
    Call Zeile11
    End If

    If Range("I12") = "6. Kyu" And Range("B12") = "x" Or Range("I12") = "6.1 Kyu" And Range("B12") = "x" Or Range("I12") = "5. Kyu" And Range("B12") = "x" Or Range("I12") = "5.1 Kyu" And Range("B12") = "x" Then
    Call Zeile12
    End If

    If Range("I13") = "6. Kyu" And Range("B13") = "x" Or Range("I13") = "6.1 Kyu" And Range("B13") = "x" Or Range("I13") = "5. Kyu" And Range("B13") = "x" Or Range("I13") = "5.1 Kyu" And Range("B13") = "x" Then
    Call Zeile13
    End If

    If Range("I14") = "6. Kyu" And Range("B14") = "x" Or Range("I14") = "6.1 Kyu" And Range("B14") = "x" Or Range("I14") = "5. Kyu" And Range("B14") = "x" Or Range("I14") = "5.1 Kyu" And Range("B14") = "x" Then
    Call Zeile14
    End If

    If Range("I15") = "6. Kyu" And Range("B15") = "x" Or Range("I15") = "6.1 Kyu" And Range("B15") = "x" Or Range("I15") = "5. Kyu" And Range("B15") = "x" Or Range("I15") = "5.1 Kyu" And Range("B15") = "x" Then
    Call Zeile15
    End If

    If Range("I16") = "6. Kyu" And Range("B16") = "x" Or Range("I16") = "6.1 Kyu" And Range("B16") = "x" Or Range("I16") = "5. Kyu" And Range("B16") = "x" Or Range("I16") = "5.1 Kyu" And Range("B16") = "x" Then
    Call Zeile16
    End If

    If Range("I17") = "6. Kyu" And Range("B17") = "x" Or Range("I17") = "6.1 Kyu" And Range("B17") = "x" Or Range("I17") = "5. Kyu" And Range("B17") = "x" Or Range("I17") = "5.1 Kyu" And Range("B17") = "x" Then
    Call Zeile17
    End If

    If Range("I18") = "6. Kyu" And Range("B18") = "x" Or Range("I18") = "6.1 Kyu" And Range("B18") = "x" Or Range("I18") = "5. Kyu" And Range("B18") = "x" Or Range("I18") = "5.1 Kyu" And Range("B18") = "x" Then
    Call Zeile18
    End If

    If Range("I19") = "6. Kyu" And Range("B19") = "x" Or Range("I19") = "6.1 Kyu" And Range("B19") = "x" Or Range("I19") = "5. Kyu" And Range("B19") = "x" Or Range("I19") = "5.1 Kyu" And Range("B19") = "x" Then
    Call Zeile19
    End If

    If Range("I20") = "6. Kyu" And Range("B20") = "x" Or Range("I20") = "6.1 Kyu" And Range("B20") = "x" Or Range("I20") = "5. Kyu" And Range("B20") = "x" Or Range("I20") = "5.1 Kyu" And Range("B20") = "x" Then
    Call Zeile20
    End If

    If Range("I21") = "6. Kyu" And Range("B21") = "x" Or Range("I21") = "6.1 Kyu" And Range("B21") = "x" Or Range("I21") = "5. Kyu" And Range("B21") = "x" Or Range("I21") = "5.1 Kyu" And Range("B21") = "x" Then
    Call Zeile21
    End If

    If Range("I22") = "6. Kyu" And Range("B22") = "x" Or Range("I22") = "6.1 Kyu" And Range("B22") = "x" Or Range("I22") = "5. Kyu" And Range("B22") = "x" Or Range("I22") = "5.1 Kyu" And Range("B22") = "x" Then
    Call Zeile22
    End If

    If Range("I23") = "6. Kyu" And Range("B23") = "x" Or Range("I23") = "6.1 Kyu" And Range("B23") = "x" Or Range("I23") = "6. Kyu" And Range("B23") = "x" Or Range("I23") = "5.1 Kyu" And Range("B23") = "x" Then
    Call Zeile23
    End If

    If Range("I24") = "6. Kyu" And Range("B24") = "x" Or Range("I24") = "6.1 Kyu" And Range("B24") = "x" Or Range("I24") = "6. Kyu" And Range("B24") = "x" Or Range("I24") = "5.1 Kyu" And Range("B24") = "x" Then
    Call Zeile24
    End If

    If Range("I25") = "6. Kyu" And Range("B25") = "x" Or Range("I25") = "6.1 Kyu" And Range("B25") = "x" Or Range("I25") = "6. Kyu" And Range("B25") = "x" Or Range("I25") = "5.1 Kyu" And Range("B25") = "x" Then
    Call Zeile25
    End If
    
 '***********************************************************************************
 
    If Range("I6") = "4. Kyu" And Range("B6") = "x" Then
    Call Zeile6_4
    End If
    
    If Range("I7") = "4. Kyu" And Range("B7") = "x" Then
    Call Zeile7_4
    End If
    
    If Range("I8") = "4. Kyu" And Range("B8") = "x" Then
    Call Zeile8_4
    End If

    If Range("I9") = "4. Kyu" And Range("B9") = "x" Then
    Call Zeile9_4
    End If

    If Range("I10") = "4. Kyu" And Range("B10") = "x" Then
    Call Zeile10_4
    End If

    If Range("I11") = "4. Kyu" And Range("B11") = "x" Then
    Call Zeile11_4
    End If

    If Range("I12") = "4. Kyu" And Range("B12") = "x" Then
    Call Zeile12_4
    End If

    If Range("I13") = "4. Kyu" And Range("B13") = "x" Then
    Call Zeile13_4
    End If

    If Range("I14") = "4. Kyu" And Range("B14") = "x" Then
    Call Zeile14_4
    End If

    If Range("I15") = "4. Kyu" And Range("B15") = "x" Then
    Call Zeile15_4
    End If

    If Range("I16") = "4. Kyu" And Range("B16") = "x" Then
    Call Zeile16_4
    End If

    If Range("I17") = "4. Kyu" And Range("B17") = "x" Then
    Call Zeile17_4
    End If

    If Range("I18") = "4. Kyu" And Range("B18") = "x" Then
    Call Zeile18_4
    End If

    If Range("I19") = "4. Kyu" And Range("B19") = "x" Then
    Call Zeile19_4
    End If

    If Range("I20") = "4. Kyu" And Range("B20") = "x" Then
    Call Zeile20_4
    End If

    If Range("I21") = "4. Kyu" And Range("B21") = "x" Then
    Call Zeile21_4
    End If

    If Range("I22") = "4. Kyu" And Range("B22") = "x" Then
    Call Zeile22_4
    End If

    If Range("I23") = "4. Kyu" And Range("B23") = "x" Then
    Call Zeile23_4
    End If

    If Range("I24") = "4. Kyu" And Range("B24") = "x" Then
    Call Zeile24_4
    End If

    If Range("I25") = "4. Kyu" And Range("B25") = "x" Then
    Call Zeile25_4
    End If
    
 '************************************************************************************
    
'Wieder zurück zu der gemerkten Zelle
    rngOld.Select
    
   
'Ab hier kommen die Meldungen und Hinweise

If Not Intersect(Range("B6:B25"), Target) Is Nothing Then
   If Target.Value = "x" Then
     MsgBox "A c h t u n g !" & vbCrLf & vbCrLf _
     & "Sie haben für diesen Prüfling eine " & vbCrLf _
     & "Zwischengürtelprüfung vorgesehen." & vbCrLf & vbCrLf _
     & "Bitte beachten Sie, dass die Techniken in den" & vbCrLf _
     & "Spalten 4 - 10 bzw. 4 - 11 als   e i n e   Technik gewertet wird." & vbCrLf _
     & "Die Zellen werden nach Eingabe" & vbCrLf _
     & "der derzeitigen Graduierung verbunden." & vbCrLf _
     & "Ein Rückgängigmachen ist nicht mehr möglich.", vbExclamation, "                Zwischengürtel-Prüfung "
   End If
End If

If Not Intersect(Range("I6:I25"), Target) Is Nothing Then               'Prüfen ob es ein Vollprüfung ist
    If Range("AZ" & Target.Row) = "Vollprüfung" Then
     MsgBox "" & vbCrLf _
     & "Aufgrund Ihrer vorgenommenen Angaben ist dies eine Vollgürtelprüfung!" & vbCrLf & vbCrLf _
     & "Bitte überprüfen Sie, ob das 'x' für Zwischengürtelprüfung bzw. " & vbCrLf _
     & "die 'Graduierung z. Zt.' richtig eingestellt ist." & vbCrLf & vbCrLf _
     & "Sollten die Zellen der Spalten 4 - 10 bzw. 4 - 11 bereits verbunden sein, " & vbCrLf _
     & "kann dies nicht mehr rückgängig gemacht werden. " & vbCrLf _
     & "Bitte kennzeichnen Sie diesen Eintrag deutlich als fehlerhaft " & vbCrLf _
     & "und erstellen Sie für diesen Prüfling einen neuen. ", vbExclamation, "           Bitte beachten Sie .....   "
    End If
End If


If Not Intersect(Range("J6:AC25"), Target) Is Nothing Then
   If Target.Value = 1 Then
     MsgBox "A c h t u n g !" & vbCrLf & vbCrLf _
     & "Sie haben eine '1' für 'ungenügend' vergeben." & vbCrLf _
     & "Die Prüfung könnte abgebrochen werden." & vbCrLf & vbCrLf _
     & "Bei zwei Prüfern gilt die Prüfung als nicht" & vbCrLf _
     & "bestanden, wenn beide Prüfer, unabhänging" & vbCrLf _
     & "vom Prüfungsfach, mit 'ungenügend' bewerten.", vbExclamation, "     Soll die Prüfung für diesen Prüfling abgebrochen werden ?"
   End If
End If


If Not Intersect(Range("I6:I25"), Target) Is Nothing Then
   If Target.Value = "3. Kyu" And Range("BI14") < 2 Then
     MsgBox "" & vbCrLf _
     & "Für die Prüfung   z u m   2. Kyu ist ein" & vbCrLf _
     & "Zweitprüfer erforderlich, der von" & vbCrLf _
     & "einem Fremdverein stammen muss.", vbExclamation, "               Bitte beachten Sie .....   "
   End If
End If


If Not Intersect(Range("I6:I25"), Target) Is Nothing Then
   If Target.Value = "2. Kyu" And Range("BI14") < 2 Then
     MsgBox "" & vbCrLf _
     & "Für die Prüfung   z u m   1. Kyu ist ein" & vbCrLf _
     & "Zweitprüfer erforderlich, der von" & vbCrLf _
     & "einem Fremdverein stammen muss.", vbExclamation, "               Bitte beachten Sie .....   "
   End If
End If


If Not Intersect(Range("F6:F25"), Target) Is Nothing And Range("BI10") = "Kyu" Then              ' Prüfen ob Fremdverein => BH6
   If Target.Value <> Range("BI6").Value Then
     MsgBox "" & vbCrLf _
     & "Der Prüfling kommt von einem Fremdverein." & vbCrLf & vbCrLf _
     & "Für die Prüfung muss eine schriftliche" & vbCrLf _
     & "Einverständniserklärung seines Vereins vorliegen." & vbCrLf & vbCrLf _
     & "Eine schriftliche Bestätigung hierüber ist der " & vbCrLf _
     & "Geschäftsstelle/Prüfungsreferent des " & vbCrLf _
     & "zuständigen Landesverbandes zuzusenden", vbExclamation, "               Bitte beachten Sie .....   "
   End If
End If


'Zellen mit "X" gegen Überschreiben sperren
'Im Bereich J:AL werden Formeln vorausgesetzt, die ein X liefern können
   Dim rngRow  As Range
   Dim rngCell As Range
   Me.Protect "", UserInterFaceOnly:=True       ' Blattschutz setzen mit VBA Freigabe

   ' Eingabebereich
   If Intersect(Target, Range("I6:I25")) Is Nothing Then Exit Sub

   With Target                              ' Zeile/n der geänderten Zelle/n
      Set rngRow = .Offset(0, 1).Resize(.Count, Columns("AL").Column - .Column)
         rngRow.Locked = False
   End With

   For Each rngCell In rngRow               ' Alle Zelle nach Zellenwert sperren
      With rngCell
         .Locked = .Value = "X"
      End With
   Next rngCell

   Me.Range("AG6:AJ25").Locked = True       'Diesen Bereich auch sperren

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Die Tabelle arbeitet vom Prinzip her so wie sie soll. Es gibt aber ein Sonderfall. Um diesen zu markieren muss in Spalte B ab Zeile 6 ein kleines "x" eingetragen werden, welches veranlasst, dass die Zellen ab M6 bis S6 zusammengefasst werden und am Ende in Spalte AG der Wert abgeändert wird.
Bisher ist es so, dass das Markro in Spalte B das "x" nicht erkennt. Es wird jede Eingabe mit einer Fehlermeldung des Scripts quittiert, dass für eine Zwischnprüfung ein kleines "x" eingegeben werden muss, egal ob nun ein "x" oder sonst was eingegeben wurde.
Gibt es hier jemanden der diesen Fehler beheben könnte?
Ich bin Programmierungstechnisch leider nicht so bewandert. Für den Fall, dass es sogar jemanden gibt, der Ju-Jutsu im DJJV betreibt, das ist eine Tabelle zur Erfassung von Kyu- und Dan-Prüfungen. Leider verwendet der Autor ausschließlich MS-Office :roll:

Re: LibreOffice Basic, wer kann VBA Excel code anpassen auf

Verfasst: Sa 21. Sep 2013, 12:12
von gogo
in dem Modul kommt 108 mal "Range(B" vor - man tut sich schwer festzustellen, wo genau der Fehler passiert ;)

Evtl. muss aber einfach nur diese Funktion präzisiert werden - d.h. ersetz' mal alle

Code: Alles auswählen

") = "x"
durch

Code: Alles auswählen

").Value = "x"
vllt geht's dann. Ohne die Datei selbst wird's aber schwierig etwas nachzuvollziehen. Außerdem ist die Calc-VBA-Unterstützung nicht für so komplexe Makros gedacht - das ist etwa so wie der Google Übersetzer - er möchte zwar übersetzen, aber ein Bewerbungsschreiben würde ich nicht dort übersetzen lassen :)
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de