OpenOffice.info

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

VBA Makro von Excel nach OO3

http://www.oooforum.de/viewtopic.php?t=23385

Seite 1 von 1

VBA Makro von Excel nach OO3

Verfasst: Mo, 16.03.2009 11:28
von Elektroing.1981
Hallo,

ich bin ziemlich neu hier im Forum und brauche Hilfe. Ich hatte mir für unsere Firma ein wenig Quellcode mit einigen Makros geschrieben bzw. schreiben lassen. Das geschah in Excel. Jetzt wollen wir das ganze unter Linux (Suse Ent. Desktor 10) zum laufen bekommen. Habe es dort zum einen zuerst mit OO2.4 und nun mit OO3.0.1 versucht. Es scheint, das OO Probleme damit hat.

Gibt es für dieses Problem eine einfache Lösung? Wenn jemand noch mehr Infos braucht, dann versuche ich die bei Wunsch gut zu beschreiben. Wie gesagt, das Hauptproblem ist wohl die Person die am Rechner sitzt.

Hier mal zum anschauen der Quellcode:

Code: Alles auswählen


Private Sub Workbook_Open() 
Call TextImport 
Call Diagramme 
End Sub 

Sub TextImport() 
   Dim arr As Variant, arrData As Variant, vSplit As Variant, arrSource As Variant 
   Dim dValue As Double 
   Dim iFile As Integer, iArr As Integer, iLine As Integer, iSource As Integer, iCol As Integer 
   Dim sFile As String, sTxt As String, sDate As String, sTime As String, sTmp As String, sText As String 
    
   Cells.ClearContents 
    
   arr = Array("DATE ", "TIME ", "COMPANY: ", "SETTINGS: ", "Count Objects: ", "USER: ") 
    
    Range("A1") = "Datum:" 
    Range("A2") = "Zeit:" 
    Range("A3") = "Company:" 
    Range("A4") = "User:" 
    Range("A5") = "Settings:" 
    Range("A6") = "Count Objects:" 
    Range("A8") = "Fraction" 
    Range("B8") = "Density" 
    Range("C8") = "Qty" 
    Range("D8") = "Sphericity" 
    Range("E8") = "Cubicity" 
    Range("F8") = "Concavity" 
    Range("A9") = "[mm]" 
    Range("B9") = "[%]" 
    Range("C9") = "[%]" 



   Range("B1").NumberFormat = "dd.mm.yyyy" 
   Range("B2").NumberFormat = "hh:mm:ss" 
   Range("B6").NumberFormat = "00" 
   Rows("8:9").HorizontalAlignment = xlRight 
   sFile = ThisWorkbook.Path & "\P1-_1.txt" 
' sFile = "C:\logfile.txt" 'mein Test 
   sTxt = DoParse(sFile) 
    
   arrData = Split(sTxt, vbLf) 
    
   For iLine = LBound(arrData) To UBound(arrData) 
      
      Select Case iLine 
         Case 1: 
            sTmp = arr(0) 
            vSplit = Split(arrData(iLine), sTmp) 
            sDate = vSplit(1) 
            sDate = Left(sDate, 10) 
            Cells(1, 2).Value = CDate(sDate) 
            
            sTmp = arr(1) 
            vSplit = Split(arrData(iLine), sTmp) 
            sDate = vSplit(1) 
            sDate = Left(sDate, 8) 
            sDate = Replace(sDate, ".", ":") 
            Cells(2, 2).Value = CDate(sDate) 
            
         Case 4: 
          
            sTmp = arr(2) 
            vSplit = Split(arrData(iLine), sTmp) 
            sText = vSplit(1) 
            sText = Left(sText, 20) 
            Cells(3, 2).Value = Trim(sText) 
            
            sTmp = arr(5) 
            vSplit = Split(arrData(iLine), sTmp) 
            sText = vSplit(1) 
            sText = Split(sText, "T")(0) 
            Cells(4, 2).Value = Trim(sText) 
            
          
         Case 5: 
          
            sTmp = arr(3) 
            vSplit = Split(arrData(iLine), sTmp) 
            sText = vSplit(1) 
            sText = Left(sText, 10) 
            Cells(5, 2).Value = Trim(sText) 
            
         Case 8: 
          
            sText = Split(arrData(iLine), " ")(3) 
            Cells(6, 2).Value = Trim(sText) 
            
            
         Case Is > 12 
          
            If InStr(arrData(iLine), "-----------") Then Call GetFormat: End 
            
            
            arrSource = Split(arrData(iLine), "     ") 
            
            iCol = 1 
            
            For iSource = LBound(arrSource) To UBound(arrSource) 
            
               dValue = Replace(arrSource(iSource), ".", ",") 
               Cells(iLine - 3, iCol).Value = dValue 
               iCol = iCol + 1 
                
            Next iSource 
      End Select 
      
   Next iLine 
    
End Sub 


Private Sub GetFormat() 
   With Range("A10").CurrentRegion 
      .Columns(1).NumberFormat = "00.000" 
      .Columns(2).NumberFormat = "000.00" 
      .Columns(3).NumberFormat = "000.00" 
      .Columns(4).NumberFormat = "0.0000" 
      .Columns(5).NumberFormat = "0.0000" 
      .Columns(6).NumberFormat = "0.0000" 
   End With 
End Sub 

Private Function DoParse(sFile As String) As String 

    Dim strImport As String 
    Dim lngChars As Long 
    Dim intFile As Integer 
    
    intFile = FreeFile 
    
    Open sFile For Input As intFile 
    lngChars = LOF(intFile) 
    strImport = Input(lngChars, intFile) 
    
    Close intFile 

    DoParse = strImport 

End Function 

Sub a() 
   Dim arr As Variant 
Dim sTxt As String, sText As String 
sTxt = "DATE " 
sText = "Mein DATE ist nicht vorhanden" 
arr = Split(sText, sTxt) 
MsgBox arr(0) 
End Sub 


Sub Diagramme() 
Dim dia$, i%, LL% 
LL = Cells(Rows.Count, 1).End(xlUp).Row 
For i = ActiveSheet.Shapes.Count To 1 Step -1 
    If Left(ActiveSheet.Shapes(i).Name, 5) = "Chart" Then ActiveSheet.Shapes(i).Delete 
Next i 
Range("H5").Select 
Charts.Add 
ActiveChart.ChartType = xlXYScatterLines 
ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range("J11") 
ActiveChart.SeriesCollection.NewSeries 
ActiveChart.SeriesCollection(1).XValues = "=Tabelle1!R10C1:R" & LL & "C1" 
ActiveChart.SeriesCollection(1).Values = "=Tabelle1!R10C2:R" & LL & "C2" 
ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle1" 
With ActiveChart 
    .HasTitle = False 
    .Axes(xlCategory, xlPrimary).HasTitle = True 
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _ 
    "Durchmesser x [mm]" 
    .Axes(xlValue, xlPrimary).HasTitle = True 
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = _ 
    "Dichteverteilung [%]" 
    .HasLegend = False 
    dia = Split(.Parent.Name, " ")(1) 
End With 
ActiveSheet.Shapes("Diagramm " & dia).IncrementLeft 114.75 
ActiveSheet.Shapes("Diagramm " & dia).IncrementTop -111.75 
Range("H35").Select 
Charts.Add 
ActiveChart.ChartType = xlXYScatterLines 
ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range("H35") 
ActiveChart.SeriesCollection.NewSeries 
ActiveChart.SeriesCollection(1).XValues = "=Tabelle1!R10C1:R" & LL & "C1" 
ActiveChart.SeriesCollection(1).Values = "=Tabelle1!R10C3:R" & LL & "C3" 
ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle1" 
With ActiveChart 
    .HasTitle = False 
    .Axes(xlCategory, xlPrimary).HasTitle = True 
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _ 
    "Durchmesser x [mm]" 
    .Axes(xlValue, xlPrimary).HasTitle = True 
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Summendurchgang [%]" 
    .HasLegend = False 
    dia = Split(.Parent.Name, " ")(1) 
End With 
ActiveSheet.Shapes("Diagramm " & dia).IncrementLeft 114.75 
ActiveSheet.Shapes("Diagramm " & dia).IncrementTop 218.25 
Range("A5").Select 
End Sub

Re: VBA Makro von Excel nach OO3

Verfasst: Fr, 20.03.2009 02:04
von Bäuerle
Hallo Elektroing

Gib doch noch ein Beispiel, wie deine Importdatei aussieht.

Andy

Re: VBA Makro von Excel nach OO3

Verfasst: Fr, 20.03.2009 08:04
von Elektroing.1981
Hallo Andy, also so sieht die Quelldatei aus:

Code: Alles auswählen

-------------------------------------------------------------------
     LOGFILE xxxxxx-xxxxxxxxxxx, DATE 07.01.2009  TIME 13.28.17 
-------------------------------------------------------------------

  COMPANY: xxxxxx xxxx             USER: xx. xxxxxxx T=1,2 k=0,955 
  SETTINGS: 1 HYDRO                

-------------------------------------------------------------------
 Count Objects: 1369950            Capacity optional: yes 

 Fraction   Density    Qty        Sphericity Cubicity   Concavity  
 [mm]       [%]        [%]
-------------------------------------------------------------------
 00.000     000.14     000.00     0.8893     1.6980     1.6000
 00.120     001.32     000.14     0.8883     1.6011     1.5599
 00.180     003.45     001.46     0.9181     1.4050     1.3663
 00.250     009.21     004.91     0.9666     1.3391     1.2937
 00.360     014.63     014.12     1.0164     1.2937     1.2431
 00.500     017.59     028.75     1.0575     1.2630     1.2102
 00.710     016.33     046.34     1.0877     1.2433     1.1890
 01.000     015.89     062.67     1.1121     1.2267     1.1723
 01.400     013.21     078.56     1.1311     1.2011     1.1490
 02.000     007.08     091.76     1.1443     1.1705     1.1223
 02.800     001.16     098.84     1.1549     1.1556     1.1014
 04.000     000.00     100.00     0.0000     0.0000     0.0000
-------------------------------------------------------------------
  Average                         1.0333     1.3270     1.2734 
-------------------------------------------------------------------
  Parameter:

     S(1.40) = 78.5579
     S(3.55) = 99.5650
     Q(10.00) = 0.3108
     Q(50.00) = 0.7750
     Q(75.00) = 1.3104
     Q(90.00) = 1.9198
-------------------------------------------------------------------
Das ist eins Ascii codierte .txt Datei wenn es dir weiterhilft. Beim öffnen mit Word sieht es wie oben aus. Ist das so ok für dich?

Re: VBA Makro von Excel nach OO3

Verfasst: Fr, 20.03.2009 09:49
von Elektroing.1981
Hallo also ich habe es unter OO2.4 probiert (da ich zu dumm bin 3.0.1 zu installieren) und da wird der Basic Syntax Fehler Unerwartetes Symbol:CRLF beim öffnen der Datei angezeigt. Vielleicht kannst du etwas damit anfangen.

Re: VBA Makro von Excel nach OO3

Verfasst: Sa, 21.03.2009 03:21
von Bäuerle
Hallo Elektroing,

folgender Code lief unter Knoppix und OO 3.0

Code: Alles auswählen

Private Sub Workbook_Open 
Call TextImport 
rem Call Diagramme 
End Sub 

Sub TextImport 
   Dim arr As Variant
   dim arrData()
   dim vSplit As Variant, arrSource As Variant 
   Dim dValue As Double 
   Dim iFile As Integer, iArr As Integer, iLine As Integer, iSource As Integer, iCol As Integer 
   Dim sFile As String, sTxt As String, sDate As String, sTime As String, sTmp As String, sText As String 
  
  Dim oSheet as Object

   arr = Array("DATE ", "TIME ", "COMPANY: ", "SETTINGS: ", "Count Objects: ", "USER: ")
   
   oSheet=thisComponent.sheets(0) 
    mycell = oSheet.getCellRangeByName("A1:I9")
	flag=com.sun.star.sheet.CellFlags.VALUE+com.sun.star.sheet.CellFlags.STRING+com.sun.star.sheet.CellFlags.HARDATTR
	mycell.clearcontents(flag)
    
   with oSheet
   	.getCellRangeByName("A1").String = "Datum:" 
    .getCellRangeByName("A2").String = "Zeit:" 
    .getCellRangeByName("A3").String = "Company:" 
    .getCellRangeByName("A4").String = "User:" 
    .getCellRangeByName("A5").String = "Settings:" 
    .getCellRangeByName("A6").String = "Count Objects:" 
    .getCellRangeByName("A8").String = "Fraction" 
    .getCellRangeByName("B8").String = "Density" 
    .getCellRangeByName("C8").String = "Qty" 
    .getCellRangeByName("D8").String = "Sphericity" 
    .getCellRangeByName("E8").String = "Cubicity" 
    .getCellRangeByName("F8").String = "Concavity" 
    .getCellRangeByName("A9").String = "[mm]" 
    .getCellRangeByName("B9").String = "[%]" 
    .getCellRangeByName("C9").String = "[%]" 



   .getCellRangeByName("B1").NumberFormat = 30 
   .getCellRangeByName("B2").NumberFormat = 44 
   .getCellRangeByName("B6").NumberFormat = 1 
   .getCellRangeByName("A8:I9").HoriJustify = com.sun.star.table.CellHoriJustify.RIGHT
   
  rem 	sFile = convertToUrl("/home/knoppix/Desktop/P1-_1.txt") 
  rem 	sFile = convertToUrl("/media/hdd1/Documents and Settings/Paul/Desktop" & "/P1-_1.txt") 
    sFile = convertToUrl("C:\Documents and Settings\Paul\Desktop" & "\P1-_1.txt")

' sFile = "C:\logfile.txt" 'mein Test  

    sTxt = DoParse(sFile, arrData())
    
   For iLine = LBound(arrData()) To UBound(arrData()) 
   
      Select Case iLine 
         Case 1: 
            sTmp = arr(0)
            vSplit = Split(arrData(iLine), sTmp)
            sDate = vSplit(1) 
            sDate = Left(sDate, 10) 
            .getCellByPosition(1, 0).setValue(cDate(sDate) 
            
            sTmp = arr(1) 
            vSplit = Split(arrData(iLine), sTmp) 
           msgbox vSplit(1)
           sDate = vSplit(1) 
            sDate = Left(sDate, 8) 
          sDate = Join( Split (sDate, "."), ":")
           .getCellByPosition(1, 1).setValue(cDate(sDate) 
            
         Case 4: 
         
            sTmp = arr(2) 
            vSplit = Split(arrData(iLine), sTmp) 
            sText = vSplit(0) 
            sText = Left(sText, 20)
            .getCellByPosition(1, 2).setValue(Trim(sText)) 
            
            sTmp = arr(5) 
            vSplit = Split(arrData(iLine), sTmp) 
            sText = vSplit(0) 
           .getCellByPosition(1, 3).setValue(Trim(sText))  
      
         Case 5: 
          
            sTmp = arr(3) 
            vSplit = Split(arrData(iLine), sTmp) 
            sText = vSplit(0) 
            sText = Left(sText, 10)
            .getCellByPosition(1, 3).setValue(Trim(sText))
     rem f   Cells(5, 2).Value = Trim(sText) 
            
         Case 8: 
          vSplit = Split(arrData(iLine))  
           sText=vSplit(0)
            rem f , " ", 3)
            .getCellByPosition(1, 5).setValue(Trim(sText) 
        rem f    Cells(6, 2).Value = Trim(sText) 
            
            
         Case Is > 12 
          
            If InStr(arrData(iLine), "-----------") Then Call GetFormat: End 
            
            msgbox(arrdata(iLine))
            arrSource = Split(arrData(iLine), "     ")      rem , "     ") 
            
            iCol = 0 
            
            For iSource = LBound(arrSource) To UBound(arrSource) 
   
                dValue = Val(Join( Split(arrSource(iSource), "."), ","))
          oSheet.getCellByPosition(iCol, iLine-4).setValue(dValue)
               iCol = iCol + 1 
                
            Next iSource 
      End Select 
      
   Next iLine 
  end with    
End Sub


Private Sub GetFormat 
   With getCellRangeByName("A10").CurrentRegion 
      .Columns(1).NumberFormat = "00.000" 
      .Columns(2).NumberFormat = "000.00" 
      .Columns(3).NumberFormat = "000.00" 
      .Columns(4).NumberFormat = "0.0000" 
      .Columns(5).NumberFormat = "0.0000" 
      .Columns(6).NumberFormat = "0.0000" 
   End With 
End Sub 

Private Function DoParse(sFile As String, arrdata()) As String 

     Dim strImport As String 
     Dim intFile As Integer 
     Dim sZeile as String
    
    intFile = FreeFile 
    
    Dim cCount as Integer
    cCount = 0
    
    Open sFile For Input As intFile 
    	do while not eof(intFile)
    		Line input #intfile, sZeile
    		ReDim Preserve arrData(cCount)
    		arrData(cCount) = sZeile
    		cCount = cCount + 1		
    Loop
   
    Close intFile 

End Function 

Sub a 
   Dim arr As Variant 
Dim sTxt As String, sText As String 
sTxt = "DATE " 
sText = "Mein DATE ist nicht vorhanden" 
arr = Split(sText, sTxt) 
MsgBox arr(0) 
End Sub 


Sub Diagramme 
Dim dia$, i%, LL% 
LL = Cells(Rows.Count, 1).End(xlUp).Row 
For i = ActiveSheet.Shapes.Count To 1 Step -1 
    If Left(ActiveSheet.Shapes(i).Name, 5) = "Chart" Then ActiveSheet.Shapes(i).Delete 
Next i 
getCellRangeByName("H5").Select 
Charts.Add 
ActiveChart.ChartType = xlXYScatterLines 
ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range("J11") 
ActiveChart.SeriesCollection.NewSeries 
ActiveChart.SeriesCollection(1).XValues = "=Tabelle1!R10C1:R" & LL & "C1" 
ActiveChart.SeriesCollection(1).Values = "=Tabelle1!R10C2:R" & LL & "C2" 
ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle1" 
With ActiveChart 
    .HasTitle = False 
    .Axes(xlCategory, xlPrimary).HasTitle = True 
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Durchmesser x [mm]" 
    .Axes(xlValue, xlPrimary).HasTitle = True 
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = _
        "Dichteverteilung [%]" 
    .HasLegend = False 
rem f    dia = Split(.Parent.Name, " ")(1) 
End With 
ActiveSheet.Shapes("Diagramm " & dia).IncrementLeft 114.75 
rem f ActiveSheet.Shapes("Diagramm " & dia).IncrementTop -111.75 
Range("H35").Select 
Charts.Add 
ActiveChart.ChartType = xlXYScatterLines 
ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range("H35") 
ActiveChart.SeriesCollection.NewSeries 
ActiveChart.SeriesCollection(1).XValues = "=Tabelle1!R10C1:R" & LL & "C1" 
ActiveChart.SeriesCollection(1).Values = "=Tabelle1!R10C3:R" & LL & "C3" 
ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle1" 
With ActiveChart 
    .HasTitle = False 
    .Axes(xlCategory, xlPrimary).HasTitle = True 
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Durchmesser x [mm]" 
    .Axes(xlValue, xlPrimary).HasTitle = True 
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Summendurchgang [%]" 
    .HasLegend = False 
rem f    dia = Split(.Parent.Name, " ")(1) 
End With 
ActiveSheet.Shapes("Diagramm " & dia).IncrementLeft 114.75 
ActiveSheet.Shapes("Diagramm " & dia).IncrementTop 218.25 
Range("A5").Select 
End Sub
>flag=com.sun.star.sheet.CellFlags.VALUE+com.sun.star.sheet.CellFlags.STRING+com.sun.star.sheet.CellFlags.HARDATTR <ergibt eine Zeile, wurde oben umgebrochen

was jetzt noch fehlt, ist die richtige Formatierung und die Diagramme.
Den Pfad zu deinem Textfile musst du noch anpassen.
Der Code rennt noch in einen Fehler bei der Formatierung, welche noch nicht angepasst ist.
Die Daten werden allerdings bei meinem Testlauf importiert.
OO bringt noch die Werte im falschen Format, so dass beim Einfügen der Werte evtl auf "setFormula" zurückgegriffen werden muss,
anstatt 00,1234 bringt OO 1234. Diese stellt es intern wohl um.

soweit mal
grüße Andy

Re: VBA Makro von Excel nach OO3

Verfasst: Mi, 25.03.2009 11:06
von Bäuerle
Macro_einl.ods
(17.3 KiB) 89-mal heruntergeladen
Datei anhängen hat nicht funktioniert ?
hohfe aber jetzt.

gruß
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de