Dezimalstellendarstellung
05.10.2016 14:12:49
Tim
Sub Schaltfläche1_Klicken()
Dim WB As Workbook
Dim iXLS As String
Dim iLOG As String
Dim filename As String
Dim pfad As String
sFiles = Application.GetOpenFilename("alle Dateien (*.*), *.*", MultiSelect:=True)
If Not IsArray(sFiles) Then Exit Sub
If UBound(sFiles) > 2 Then MsgBox "zu viele Dateien": Exit Sub
For i = 1 To UBound(sFiles)
'Debug.Print sFiles(i)
If InStr(sFiles(i), ".xls") > 0 Then iXLS = sFiles(i)
If InStr(sFiles(i), ".LOG") > 0 Then iLOG = sFiles(i)
Next i
Set WB = Workbooks.Open(iXLS)
WB.Sheets.Add , WB.Sheets(Sheets.Count), , iLOG
' Log-Bearbeitung
Dim rng As Long
Range("A2").Select
ActiveCell.FormulaR1C1 = _
" Measuring length: 1.010 meter" & Chr(13) & "" & Chr(10) & " PC-time: Mon Aug 01 11: _
16:14 2016"
Range("A1").Select
ActiveCell.FormulaR1C1 = _
" Instrument serial number: 2616" & Chr(13) & "" & Chr(10) & " LineNo-GasName-Unit: 1- _
O2-% " & Chr(10) & " Measuring length: 1.010 meter" & Chr(10) & " PC-time: Mon Aug 01 11:16:14 2016"
Range("A3").Select
ActiveCell.FormulaR1C1 = _
" sec = seconds after midnight (PC-time)" & Chr(13) & "" & Chr(10) & " GasName-LineNo/i/ _
a/s = gas concentration inst/avg/std"
Range("A1").Select
ActiveCell.FormulaR1C1 = _
" Instrument serial number: 2616" & Chr(13) & "" & Chr(10) & " LineNo-GasName-Unit: 1- _
O2-% " & Chr(10) & " Measuring length: 1.010 meter" & Chr(10) & " PC-time: Mon Aug 01 11:16:14 2016" & Chr(10) & " sec = seconds after midnight (PC-time)" & Chr(10) & " GasName-LineNo/i/a/s = gas concentration inst/avg/std"
Range("A4").Select
ActiveCell.FormulaR1C1 = _
" LineNo-lw/lp/la = line width/line position/line amplitude" & Chr(13) & "" & Chr(10) & _
" sts = instrument status: SLEEPMODE/STARTUP/OK/WARNING/ERROR = -4/-1/0/1/2"
Range("A1").Select
ActiveCell.FormulaR1C1 = _
" Instrument serial number: 2616" & Chr(13) & "" & Chr(10) & " LineNo-GasName-Unit: 1- _
O2-% " & Chr(10) & " Measuring length: 1.010 meter" & Chr(10) & " PC-time: Mon Aug 01 11:16:14 2016" & Chr(10) & " sec = seconds after midnight (PC-time)" & Chr(10) & " GasName-LineNo/i/a/s = gas concentration inst/avg/std" & Chr(10) & " LineNo-lw/lp/la = line width/line position/line amplitude" & Chr(10) & " sts = instrument status: SLEEPMODE/STARTUP/OK/WARNING/ERROR = -4/-1/0/1/2"
Range("A5").Select
ActiveCell.FormulaR1C1 = " mode = measurement mode: OK/ZERO/SPAN = 0/1/2" & Chr(13) & "" & _
Chr(10) & " 1"
Range("A1").Select
ActiveCell.FormulaR1C1 = _
" Instrument serial number: 2616" & Chr(13) & "" & Chr(10) & " LineNo-GasName-Unit: 1- _
O2-% " & Chr(10) & " Measuring length: 1.010 meter" & Chr(10) & " PC-time: Mon Aug 01 11:16:14 2016" & Chr(10) & " sec = seconds after midnight (PC-time)" & Chr(10) & " GasName-LineNo/i/a/s = gas concentration inst/avg/std" & Chr(10) & " LineNo-lw/lp/la = line width/line position/line amplitude" & Chr(10) & " sts = instrument status: SLEEPMODE/STARTUP/OK/WARNING/ERROR = -4/-1/0/1/2" & Chr(10) & " mode = " & _
" mode = measurement mode: OK/ZERO/SPAN = 0/1/2" & Chr(13) & "" & Chr(10) & " 1"
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("2:5").Select
Selection.Delete Shift:=xlUp
Range("A1:X1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Rows("1:1").RowHeight = 160.5
Range("A2").Select
ActiveCell.FormulaR1C1 = "time"
Range("A3").Select
ActiveCell.FormulaR1C1 = "=RC[1]/86400"
Range("A3").Select
Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
rng = Range("B65526").End(xlUp).Row
Range("A3").Select
Selection.AutoFill Destination:=Range(Cells(3, 1), Cells(rng, 1)), Type:=xlFillDefault
ActiveSheet.Previous.Select
' xls-Bearbeitung
Columns("A:A").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Range("B3:H3").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A7").Select
Selection.Delete Shift:=xlToLeft
' Speichern
filename = Replace(WB.Name, ".xls", "")
MsgBox filename
pfad = "D:\Eigene Dateien\" & filename & ".xlsx"
MsgBox pfad
WB.SaveAs pfad
WB.SaveAs filename:=pfad, FileFormat:=xlOpenXMLWorkbook
End Sub
ICh weiß der Code ist lang, aber ich kann den Fehler nicht identifizieren, deswegen das volle Skript!