OpenOffice.info

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

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
-------------------------------------------------------------------

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