OpenOffice.info

deutsches Forum rund um Apache OpenOffice und LibreOffice
https://oooforum.de/

Makro aus xls Datei zum laufen bekommen

https://oooforum.de/viewtopic.php?t=49460

Seite 1 von 1

Makro aus xls Datei zum laufen bekommen

Verfasst: Do, 21.07.2011 09:31
von Rango
Tag zusammen,

ich habe hier eine XLS-Datei mit einem Makro vorliegen.

Dieses würde ich gerne unter KDE und OO ausführen, allerdings hab ich keine Ahnung wie das gehen soll.

Kann mir bitte jemand weiterhelfen?

Danke

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Do, 21.07.2011 09:34
von bst
Morgen,

zeige mal den Code her?

cu, Bernd

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Do, 21.07.2011 09:40
von Rango
bst hat geschrieben:Morgen,

zeige mal den Code her?

cu, Bernd
Hallo Bernd,

wie kann man diesen den auslesen?

Die Datei selber darf/kann ich nicht hochladen

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Do, 21.07.2011 09:46
von bst
Hi,

In die VBA-Entwicklungsumgebung kommst Du mit Extras-Makro-Visual Basic Editor oder ALT+F11.

Dann starte den Projektexplorer via Ansicht- Projektexplorer oder STRG+R.

Dort mache auf jedem Eintrag unter Deiner Mappe einen Doppelklick und schaue rechts im Codefenster nach ob dort Code steht.

cu, Bernd

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Do, 21.07.2011 09:51
von Rango
So es sind verschiedene Einträge vorhanden:

Diese Arbeitsmappe:

Code: Alles auswählen

Rem Attribute VBA_ModuleType=VBADocumentModule
Sub DieseArbeitsmappe
Rem Option Explicit
Rem 
Rem Const datGültigBis = #12/31/2011#
Rem 
Rem Private Sub Workbook_Open()
Rem 
Rem     If Date > datGültigBis Then
Rem     
Rem         MsgBox "Das Tool hat nur eine Gültigkeit bis zum " + FormatDateTime(datGültigBis, vbShortDate) + ".", vbOKOnly + vbInformation
Rem         
Rem         Me.Close False
Rem         
Rem     Else
Rem     
Rem         str_Tabelle = "BZ10"
Rem     
Rem         Worksheets("BZ10").Activate
Rem         
Rem     End If
Rem 
Rem End Sub
Rem 
End Sub
frm_Auswahl:

Code: Alles auswählen

Rem Attribute VBA_ModuleType=VBAFormModule
Sub frm_Auswahl
Rem Option Explicit
Rem 
Rem Private Sub cmd_Entfernen_Click()
Rem 
Rem     AuswahlVerschieben False
Rem     
Rem End Sub
Rem 
Rem Private Sub cmd_Hinzufügen_Click()
Rem 
Rem     If Me.lst_Auswahl.ListCount + AnzahlAuswahl(Me.lst_Gesamt) > 7 Then
Rem     
Rem         MsgBox "Es dürfen höchstens 7 weitere Versicherer ausgewählt werden!", vbOKOnly + vbInformation, _
Rem             "Versicherer auswählen"
Rem     
Rem     Else
Rem     
Rem         AuswahlVerschieben True
Rem         
Rem     End If
Rem 
Rem End Sub
Rem 
Rem Private Sub cmd_OK_Click()
Rem 
Rem     Dim byt_Index       As Byte
Rem     Dim byt_Nummer      As Byte
Rem     Dim byt_Spalte      As Byte
Rem     Dim byt_Zeile       As Byte
Rem     Dim byt_Bereich     As Byte
Rem     Dim byt_Position    As Byte
Rem     Dim byt_Fußzeile    As Byte
Rem     Dim int_Index       As Integer
Rem     Dim bol_Sichtbar    As Boolean
Rem     Dim str_Fußzeile    As String
Rem     Dim str_Fußnote     As String
Rem     Dim str_Zuordnung   As String
Rem     
Rem     Unload Me
Rem 
Rem     Worksheets(str_Tabelle).Unprotect "gre32"
Rem     
Rem     For byt_Bereich = 1 To Worksheets(str_Tabelle).Range("Männer").Areas.Count
Rem     
Rem         For byt_Spalte = 1 To Worksheets(str_Tabelle).Range("Männer").Areas(byt_Bereich).Rows.Count
Rem         
Rem             Worksheets(str_Tabelle).Range("Männer").Areas(byt_Bereich).Rows(byt_Spalte).Hidden = Not bol_Männer
Rem             
Rem         Next
Rem         
Rem     Next
Rem     
Rem     For byt_Bereich = 1 To Worksheets(str_Tabelle).Range("Frauen").Areas.Count
Rem     
Rem         For byt_Spalte = 1 To Worksheets(str_Tabelle).Range("Frauen").Areas(byt_Bereich).Rows.Count
Rem         
Rem             Worksheets(str_Tabelle).Range("Frauen").Areas(byt_Bereich).Rows(byt_Spalte).Hidden = bol_Männer
Rem             
Rem         Next
Rem         
Rem     Next
Rem     
Rem     For byt_Spalte = LBound(fld_Versicherer) To UBound(fld_Versicherer)
Rem             
Rem         Worksheets(str_Tabelle).Columns(byt_Spalte + 4).Hidden = Not fld_Versicherer(byt_Spalte).bol_Sichtbar
Rem                 
Rem     Next
Rem     
Rem     Worksheets(str_Tabelle).Range("Fußnoten").Sort Key1:=Worksheets(str_Tabelle).Range("Fußnoten").Cells(1, 1), _
Rem         Order1:=xlAscending, Header:=xlGuess
Rem         
Rem     Worksheets(str_Tabelle).Range("Fußnoten1").Value = ""
Rem     Worksheets(str_Tabelle).Range("Fußnoten2").Value = ""
Rem     Worksheets(str_Tabelle).Range("Fußnoten3").Value = ""
Rem     Worksheets(str_Tabelle).Range("Fußnoten4").Value = ""
Rem     
Rem     byt_Fußzeile = 1
Rem     
Rem     For byt_Index = 1 To Worksheets(str_Tabelle).Range("Fußnoten").Rows.Count
Rem     
Rem         bol_Sichtbar = False
Rem     
Rem         byt_Nummer = Worksheets(str_Tabelle).Range("Fußnoten").Cells(byt_Index, 1)
Rem         
Rem         If byt_Nummer <> 0 Then
Rem         
Rem             str_Fußzeile = CStr(byt_Nummer) + " " + Worksheets(str_Tabelle).Range("Fußnoten").Cells(byt_Index, 2)
Rem     
Rem             For byt_Spalte = LBound(fld_Versicherer) To UBound(fld_Versicherer)
Rem             
Rem                 str_Zuordnung = Worksheets(str_Tabelle).Cells(7, byt_Spalte + 4)
Rem                 byt_Position = InStr(1, str_Zuordnung, CStr(byt_Nummer))
Rem                     
Rem                 If fld_Versicherer(byt_Spalte).bol_Sichtbar And byt_Position > 0 Then
Rem                 
Rem                     If Mid(str_Zuordnung, byt_Position - 1, 1) = "*" And _
Rem                         Mid(str_Zuordnung, byt_Position + Len(CStr(byt_Nummer)), 1) = "*" Then
Rem                     
Rem                         bol_Sichtbar = True
Rem                     
Rem                     End If
Rem 
Rem                 End If
Rem                 
Rem             Next
Rem 
Rem         End If
Rem         
Rem         If bol_Sichtbar Then
Rem             
Rem             Do While Len(Worksheets(str_Tabelle).Range("Fußnoten" + CStr(byt_Fußzeile))) + Len(str_Fußzeile) > 225
Rem             
Rem                 byt_Fußzeile = byt_Fußzeile + 1
Rem                 
Rem             Loop
Rem         
Rem             With Worksheets(str_Tabelle).Range("Fußnoten" + CStr(byt_Fußzeile))
Rem             
Rem                 If .Value <> "" Then
Rem                 
Rem                     .Value = .Value + "; "
Rem                     
Rem                 End If
Rem             
Rem                 .Value = .Value + str_Fußzeile
Rem                         
Rem             End With
Rem             
Rem         End If
Rem         
Rem     Next
Rem 
Rem '    If Worksheets(str_Tabelle).Range("Fußnoten2").Value = "" Then
Rem '
Rem '        Worksheets(str_Tabelle).Range("Fußnoten2").Value = Worksheets(str_Tabelle).Range("Fußnoten3").Value
Rem '        Worksheets(str_Tabelle).Range("Fußnoten3").Value = ""
Rem '
Rem '    Else
Rem '
Rem '        If Len(Worksheets(str_Tabelle).Range("Fußnoten2").Value) < _
Rem '            Len(Worksheets(str_Tabelle).Range("Fußnoten3").Value) And _
Rem '            Len(Worksheets(str_Tabelle).Range("Fußnoten2").Value) + _
Rem '            Len(Worksheets(str_Tabelle).Range("Fußnoten3").Value) < 200 Then
Rem '
Rem '            Worksheets(str_Tabelle).Range("Fußnoten2").Value = Worksheets(str_Tabelle).Range("Fußnoten2").Value + _
Rem '                "; " + Worksheets(str_Tabelle).Range("Fußnoten3").Value
Rem '            Worksheets(str_Tabelle).Range("Fußnoten3").Value = ""
Rem '
Rem '        End If
Rem '
Rem '    End If
Rem     
Rem     For byt_Index = 1 To 4
Rem     
Rem         Select Case byt_Index
Rem         Case 1: str_Fußnote = "Fußnoten1"
Rem         Case 2: str_Fußnote = "Fußnoten2"
Rem         Case 3: str_Fußnote = "Fußnoten3"
Rem         Case 4: str_Fußnote = "Fußnoten4"
Rem         End Select
Rem         
Rem         With Worksheets(str_Tabelle).Range(str_Fußnote)
Rem         
Rem             .Characters(Start:=1, Length:=Len(.Value)).Font.Superscript = False
Rem         
Rem             For int_Index = 1 To Len(.Value)
Rem             
Rem                 If int_Index = 1 Or Mid(.Value, WorksheetFunction.Max(int_Index - 2, 1), 1) = ";" Then
Rem                 
Rem                     .Characters(Start:=int_Index, Length:=2).Font.Superscript = True
Rem 
Rem                 End If
Rem             
Rem             Next
Rem             
Rem         End With
Rem     
Rem     Next
Rem     
Rem     Worksheets(str_Tabelle).Protect "gre32"
Rem     
Rem End Sub
Rem Private Sub opt_Frauen_Click()
Rem 
Rem     bol_Männer = False
Rem      
Rem End Sub
Rem 
Rem Private Sub opt_Männer_Click()
Rem 
Rem     bol_Männer = True
Rem 
Rem End Sub
Rem 
Rem Private Sub UserForm_Initialize()
Rem 
Rem     Dim byt_Spalte  As Byte
Rem 
Rem     byt_Spalte = 4
Rem     
Rem     Do While Worksheets(str_Tabelle).Cells(6, byt_Spalte) <> ""
Rem     
Rem         ReDim Preserve fld_Versicherer(byt_Spalte - 4)
Rem     
Rem         With fld_Versicherer(byt_Spalte - 4)
Rem         
Rem             .str_Versicherer = Worksheets(str_Tabelle).Cells(6, byt_Spalte)
Rem             .bol_Sichtbar = Not Worksheets(str_Tabelle).Columns(byt_Spalte).Hidden
Rem             
Rem         End With
Rem         
Rem         byt_Spalte = byt_Spalte + 1
Rem         
Rem     Loop
Rem     
Rem     TabellenAufbauen
Rem     
Rem     If Worksheets(str_Tabelle).Rows(Worksheets(str_Tabelle).Range("Männer").Row).Hidden Then
Rem     
Rem         bol_Männer = False
Rem         
Rem         Me.opt_Frauen.Value = True
Rem         
Rem     Else
Rem     
Rem         bol_Männer = True
Rem         
Rem         Me.opt_Männer.Value = True
Rem         
Rem     End If
Rem     
Rem End Sub
Rem 
End Sub
Modul:

Code: Alles auswählen

Rem Attribute VBA_ModuleType=VBAModule
Sub Modul
Rem Option Explicit
Rem 
Rem Type t_Versicherer
Rem     str_Versicherer As String
Rem     bol_Sichtbar    As Boolean
Rem     byt_Position    As Byte
Rem End Type
Rem 
Rem Public bol_Männer           As Boolean
Rem Public fld_Versicherer()    As t_Versicherer
Rem Public str_Tabelle          As String
Rem 
Rem Public Sub AuswahlVerschieben(bol_Sichtbar As Boolean)
Rem 
Rem     Dim int_Index   As Integer
Rem     Dim byt_Spalte  As Byte
Rem     Dim lst_Tabelle As Variant
Rem     
Rem     If bol_Sichtbar Then
Rem     
Rem         Set lst_Tabelle = frm_Auswahl.lst_Gesamt
Rem         
Rem     Else
Rem     
Rem         Set lst_Tabelle = frm_Auswahl.lst_Auswahl
Rem         
Rem     End If
Rem     
Rem     For int_Index = 0 To lst_Tabelle.ListCount - 1
Rem     
Rem         If lst_Tabelle.Selected(int_Index) Then
Rem         
Rem             byt_Spalte = 0
Rem             
Rem             Do While fld_Versicherer(byt_Spalte).bol_Sichtbar <> Not bol_Sichtbar Or _
Rem                 fld_Versicherer(byt_Spalte).byt_Position <> int_Index Or _
Rem                 fld_Versicherer(byt_Spalte).str_Versicherer = "ALTE LEIPZIGER"
Rem             
Rem                 byt_Spalte = byt_Spalte + 1
Rem                 
Rem             Loop
Rem             
Rem             fld_Versicherer(byt_Spalte).bol_Sichtbar = bol_Sichtbar
Rem             
Rem         End If
Rem         
Rem     Next
Rem     
Rem     TabellenAufbauen
Rem    
Rem End Sub
Rem 
Rem Public Function AnzahlAuswahl(lst_Tabelle As Variant)
Rem 
Rem     Dim int_Index   As Integer
Rem     Dim int_Anzahl  As Integer
Rem     
Rem     For int_Index = 0 To lst_Tabelle.ListCount - 1
Rem     
Rem         If lst_Tabelle.Selected(int_Index) Then
Rem         
Rem             int_Anzahl = int_Anzahl + 1
Rem             
Rem         End If
Rem         
Rem     Next
Rem     
Rem     AnzahlAuswahl = int_Anzahl
Rem     
Rem End Function
Rem 
Rem Public Sub TabellenAufbauen()
Rem 
Rem     Dim byt_Spalte  As Byte
Rem     Dim lst_Tabelle As Variant
Rem     
Rem     frm_Auswahl.lst_Gesamt.Clear
Rem     frm_Auswahl.lst_Auswahl.Clear
Rem     
Rem     For byt_Spalte = LBound(fld_Versicherer) To UBound(fld_Versicherer)
Rem     
Rem         With fld_Versicherer(byt_Spalte)
Rem         
Rem             If .str_Versicherer <> "ALTE LEIPZIGER" Then
Rem         
Rem                 If .bol_Sichtbar Then
Rem                 
Rem                     Set lst_Tabelle = frm_Auswahl.lst_Auswahl
Rem                     
Rem                 Else
Rem                 
Rem                     Set lst_Tabelle = frm_Auswahl.lst_Gesamt
Rem                     
Rem                 End If
Rem                 
Rem                 lst_Tabelle.AddItem .str_Versicherer
Rem                     
Rem                 .byt_Position = lst_Tabelle.ListCount - 1
Rem                 
Rem             End If
Rem             
Rem         End With
Rem         
Rem     Next
Rem     
Rem End Sub
Rem 
Rem 
End Sub
Modul1:

Code: Alles auswählen

Rem Attribute VBA_ModuleType=VBAModule
Sub Modul1
Rem Option Explicit
Rem 
Rem Sub Makro2()
Rem '
Rem ' Makro2 Makro
Rem ' Makro am 04.07.2011 von Dirk Greßhöner aufgezeichnet
Rem '
Rem 
Rem '
Rem     ActiveSheet.Pictures.Insert("H:\Projekte\Gemeinsame Dateien\Icons\ALLV_2.jpg"). _
Rem         Select
Rem End Sub
Rem 
End Sub
Tabelle 1:

Code: Alles auswählen

Rem Attribute VBA_ModuleType=VBADocumentModule
Sub Tabelle1
Rem Option Explicit
Rem 
Rem Private Sub cmd_Logo_Click()
Rem 
Rem     Dim dblVerhältnis   As Double
Rem     Dim strDateiname    As String
Rem 
Rem     On Error Resume Next
Rem     
Rem     With Application.FileDialog(msoFileDialogOpen)
Rem     
Rem         .Show
Rem         
Rem         strDateiname = .SelectedItems(1)
Rem         
Rem     End With
Rem     
Rem     If strDateiname <> "" Then
Rem     
Rem         Worksheets(str_Tabelle).Unprotect "gre32"
Rem     
Rem         ActiveSheet.Pictures.Insert(strDateiname).Select
Rem             
Rem         Selection.Placement = xlFreeFloating
Rem             
Rem         With Selection.ShapeRange
Rem         
Rem             dblVerhältnis = .Width / .Height
Rem             
Rem             .Left = Me.cmd_Auswahl.Left + Me.cmd_Auswahl.Width + 5
Rem             .Top = Me.cmd_Auswahl.Top
Rem             
Rem             If 170 / dblVerhältnis <= 70 Then
Rem             
Rem                 .Width = 170
Rem                 .Height = .Width / dblVerhältnis
Rem                 
Rem             Else
Rem             
Rem                 .Height = 60
Rem                 .Width = .Height * dblVerhältnis
Rem                 
Rem             End If
Rem             
Rem             .Line.Visible = False
Rem             
Rem             .Parent.Locked = False
Rem             
Rem         End With
Rem         
Rem         Worksheets(str_Tabelle).Protect "gre32"
Rem         
Rem     End If
Rem     
Rem     On Error GoTo 0
Rem     
Rem End Sub
Rem 
Rem Private Sub cmd_Auswahl_Click()
Rem 
Rem     frm_Auswahl.Show
Rem     
Rem End Sub
Rem 
Rem Private Sub cmd_Wechsel_Click()
Rem 
Rem     str_Tabelle = "BZ10"
Rem 
Rem     Worksheets("BZ10").Activate
Rem     
Rem End Sub
Rem 
End Sub
Tabelle 2:

Code: Alles auswählen

Rem Attribute VBA_ModuleType=VBADocumentModule
Sub Tabelle2
Rem Option Explicit
Rem 
Rem Private Sub cmd_Zurück_Click()
Rem 
Rem     Worksheets(str_Tabelle).Activate
Rem     
Rem End Sub
Rem 
End Sub
Tabelle 3:

Code: Alles auswählen

Rem Attribute VBA_ModuleType=VBADocumentModule
Sub Tabelle3
Rem Option Explicit
Rem 
Rem Private Sub cmd_Auswahl_Click()
Rem 
Rem     frm_Auswahl.Show
Rem     
Rem End Sub
Rem 
Rem Private Sub cmd_Logo_Click()
Rem 
Rem     Dim dblVerhältnis   As Double
Rem     Dim strDateiname    As String
Rem 
Rem     On Error Resume Next
Rem     
Rem     With Application.FileDialog(msoFileDialogOpen)
Rem     
Rem         .Show
Rem         
Rem         strDateiname = .SelectedItems(1)
Rem         
Rem     End With
Rem     
Rem     If strDateiname <> "" Then
Rem     
Rem         Worksheets(str_Tabelle).Unprotect "gre32"
Rem     
Rem         ActiveSheet.Pictures.Insert(strDateiname).Select
Rem             
Rem         Selection.Placement = xlFreeFloating
Rem             
Rem         With Selection.ShapeRange
Rem         
Rem             dblVerhältnis = .Width / .Height
Rem             
Rem             .Left = Me.cmd_Auswahl.Left + Me.cmd_Auswahl.Width + 5
Rem             .Top = Me.cmd_Auswahl.Top
Rem             
Rem             If 170 / dblVerhältnis <= 70 Then
Rem             
Rem                 .Width = 170
Rem                 .Height = .Width / dblVerhältnis
Rem                 
Rem             Else
Rem             
Rem                 .Height = 60
Rem                 .Width = .Height * dblVerhältnis
Rem                 
Rem             End If
Rem             
Rem             .Line.Visible = False
Rem             
Rem             .Parent.Locked = False
Rem             
Rem         End With
Rem         
Rem         Worksheets(str_Tabelle).Protect "gre32"
Rem         
Rem     End If
Rem     
Rem     On Error GoTo 0
Rem     
Rem End Sub
Rem 
Rem Private Sub cmd_Wechsel_Click()
Rem 
Rem     str_Tabelle = "BZ30"
Rem 
Rem     Worksheets("BZ30").Activate
Rem     
Rem End Sub
Rem 
Rem 
End Sub

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Do, 21.07.2011 09:59
von bst
Hi Rango,

so etwas war ja zu befürchten ...

Auf den 1. Blick würde ich mal meinen es ist zwar nicht unmöglich das umzusetzen aber vermutlich mit einem (sehr) großen Zeitaufwand verbunden.

Sorry, das ist mir zu viel Aufwand :-(

cu, Bernd

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Do, 21.07.2011 10:47
von Rango
Kein Problem!

Trotzdem danke für deine Hilfe...

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Do, 21.07.2011 10:58
von Karolus
Hallo
Entferne erstmal alle "Rem"s am Zeilenanfang (→Suchen und ersetzen.. ) und schau dann mal was davon läuft.

Gruß Karo

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Do, 21.07.2011 11:31
von Rango
Dann bekommt man die Fehlermeldung:
BASIC-Syntaxfehler:
Erwartet: SUB

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Di, 16.08.2011 08:16
von Tictac
und nimm noch folgenden Teil raus:

Code: Alles auswählen

Rem Attribute VBA_ModuleType=VBADocumentModule
Du hast ja dann kein VBA mehr sondern StarBasic.
Und dann sag mal welche Zeile nicht läuft.

PS: an deiner Stelle würde ich mich aber mal etwas mit Starbasic beschäftigen. Gibt ein sehr gutes FAQ von Michael Dannehöfer (Damit hab ichs gelernt), einfach googeln.
Dann kannst du auch den Code ohne hilfe warten und verbessern.

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Di, 16.08.2011 08:24
von komma4
Tictac hat geschrieben:und nimm noch folgenden Teil raus:
Unnötig, da REM wie Remark vor der Zeile steht. Ist damit ein Kommentar und wird nicht ausgeführt (als Code).

Ansonsten gebe ich Dir recht: um-/neuschreiben in StarBasic ist der bessere Weg.



Standardtipps zum Erlernen von StarBasic:

Andrews Makro-Dokument
und ein Objekt-Inspektions-Tool, wie
XRAY

Re: Makro aus xls Datei zum laufen bekommen

Verfasst: Di, 16.08.2011 09:05
von Tictac
Unnötig, da REM wie Remark vor der Zeile steht. Ist damit ein Kommentar und wird nicht ausgeführt (als Code).
zwei Posts vorher hat er den Tip bekommen, dass er alle REMs entfernen soll. Deswegen der Hinweis den Teil zu löschen.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de