VBA-Makro in OpenOffice konvertieren?

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

Moderator: Moderatoren

MarKum
Beiträge: 4
Registriert: Mo, 03.09.2018 13:42

VBA-Makro in OpenOffice konvertieren?

Beitrag von MarKum »

Hallo, hoffe jetzt im richtigen Unterforum 8)

Habe eine Excel-Datei mit Makro im I-Net gefunden, die genau macht, was ich will. Jetzt wollen wir dies in ein OpenOffice Calc (oder LO) einfügen, um dieses dann auf mehreren Terminal-Station laufen lassen (auf diesen Terminals ist kein Excel installiert und wir wollen diese Lizenzen eben mit OO/LO somit umgehen).

Kurz zur Beschreibung:
Werker gibt am Terminal eine 7-stellige Artikel-ID ein, bekommt von der verknüpften Datenbank z.B, Benennung, Zeichnung, Projekt usw. zurück gemeldet. Zu fast jedem Artikel ist auf einem Laufwerk ein kleines Produktbild gespeichert. Dieses Bild sollte jetzt hier angezeigt werden.

Wie gesagt, im angehängten Excel funktioniert es soweit wie gewünscht, nur kommt beim konvertieren in OO oder auch LO beim Ausführen immer wieder die Fehlermeldung "Laufzeitfehler 91, Objektvariable nicht belegt".
"Option VBASupport 1" sind gesetzt

Der erste Fehler kommt hier:
Set RaBereich = Intersect(RaBereich, Range(Target.Address)) '### Laufzeitfehler 91
Kommentiere ich diese Zeile aus, kommt der nächste Fehler dann hier wieder:
(Basic-Laufzeitfehler: 423 - AddPicture)
sngHoehe = .Height ' Bildhöhe an Variable übergeben Hinweis von Uwe (:o) ### Laufzeitfehler 423
Ist ein Bild nicht in den vorgegebenen Pfad, schreibt das Makro wie gewünscht "kein Bild" in die Zelle neben der Artikelnummer, nur ein Bild wird eben nicht geholt.

Leider sind meine VBA, bzw. StarBasic-Kenntnisse absolut nicht die Besten, eher so copy/paste and test

Hoffe, der ein oder andere findet etwas Zeit, sich den Code mal anzusehen, und kann mir paar Tipps zum Umschreiben auf StarBasic geben.
Code aus dem Excel hänge ich unten mal an


Schon mal Vielen Dank für die Mühen

MarKum

Code: Alles auswählen

Option Explicit                                     ' Variablendefinition erforderlich
' Option VBASupport 1
' Konstante für Ablagepfad Bilder
Const StPfad As String = "I:\Bilder_Arbeitsplan\"

Private Sub Worksheet_Change(ByVal Target As Range)
    '**************************************************
    '* H. Ziplies                                     *
    '* 06.08.10                                       *
    '* erstellt von HajoZiplies@web.de                *
    '* http://Hajo-Excel.de/                          *
    '**************************************************
    Dim StBild As String                            ' Variable für Bildname
    Dim InI As Integer                              ' Schleifenvariable
    Dim RaBereich As Range                          ' Bereich der Wirksamtkeit
    Dim RaZelle As Range                            ' Zelle die in der Schleife bearbeitet wird
    Set RaBereich = Range("A10,A20,A30,A40")        '   Bereich der Wirksamkeit
    '   noch mehr Bereiche
    '    Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17"), _
    '        Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
    '        Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
    '        Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
    '        Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
    '        Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
    '        Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
    ' nur die Zellen Prüfen die im überwachten Bereich liegen
    Set RaBereich = Intersect(RaBereich, Range(Target.Address))               '### Laufzeitfehler 91
    If Not RaBereich Is Nothing Then                ' prüfen ob eine Zelle im überwachten Bereich
        ' Schleife über alle veränderten Zellen im überwachten Bereich
        For Each RaZelle In RaBereich
            ' Reaktion auf Zellveränderung abschalten
            Application.EnableEvents = False
            RaZelle.Offset(0, 1) = ""               ' Text "kein Bild" löschen
            ' Reaktion auf Zellveränderung einschalten
            Application.EnableEvents = True
            ' Bildname erstellen
            StBild = "Bild " & RaZelle.Address(False, False)
            ' altes Bild löschen
            Bilder_loeschen StBild, ActiveSheet.Name
            If RaZelle.Value <> "" Then             ' es wurde was eingegeben
                ' Bildname
                StBild = StPfad & Format(RaZelle.Value, "0") & ".jpg"
                If Dir(StBild) = "" Then            ' Prüfen ob Datei vorhanden
                    ' Reaktion auf Zellveränderung abschalten
                    Application.EnableEvents = False
                    Target.Offset(0, 1) = "kein Bild"
                    ' Reaktion auf Zellveränderung einschhalten
                    Application.EnableEvents = True
                Else
                    ' einfügen ohne select von  Bert Körn
                    ' Ausdruck.AddPicture(FileName, Verknüpfung, in Mappe speichern,
                    ' Pos. Links, Pos. Oben, Breite, Höhe)
                    ' von Klausimausi64 Bildname
                    ' erstes Offset Pos. Links 0 Zeilen und eine Spalte nach rechts
                    ' zweites Offset Pos. Oben 0 Zeilen tiefer und 0 Spalten nach rechts
                    With ActiveSheet.Shapes.AddPicture(StBild, True, True, _
                        RaZelle.Offset(0, 0).Left, RaZelle.Offset(1, 0).Top, 100, 100)
                        sngHoehe = .Height  ' Bildhöhe an Variable übergeben Hinweis von Uwe (:o)
                        ' Makro das bei klick auf das Bildausgeführt wird,
                        ' Makro in mdl_BeiKlick
                        .OnAction = "Bild_BeiKlick"
                        ' von Klausimausi64 Bildname
                        .Name = "Bild " & RaZelle.Address(False, False)
                    End With
                    ' ********
                End If
            End If
        Next RaZelle
    End If
    Set RaBereich = Nothing                         ' Variable leeren
End Sub

Dateianhänge
bild_einfuegen_mehrere.xls
(108 KiB) 301-mal heruntergeladen
win7prof - LO 6.0.6.2 (x64) - AOO 4.1.5