Sub auto_open()
erg = MsgBox("Convert Offline Configuration to MS-Excel ?", vbYesNoCancel, "Convert - _
Configuration")
If erg = 6 Then process
End Sub
Sub process()
Dim ta(50), tb(50), tc(50), td(50), te(50)
Dim foundpos, kopf
' Verzeichnis wechseln
ChDrive "C"
ChDir "c:\JDapps\Pricebook\Export"
' Öffnen Dialog
configfile = Application.GetOpenFilename(, , "Saved Configuration")
If configfile = False Then Exit Sub
OrgName = ActiveWorkbook.Name
' Öffnen
Workbooks.OpenText Filename:=configfile, Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, _
1), _
Array(9, 1))
' Einlesen der Maschinen-Konfigurationen
[a1].Select
n = 0
x = 0
While ActiveCell.Value ""
n = n + 1
If ActiveCell.Value = "CMNT" Then CMNT = n
If ActiveCell.Value = "TRADE" Then Trade = n
If ActiveCell.Value = "VAT" Then VAT = n
If ActiveCell.Value = "PERS" Then PERS = ActiveCell.Offset(0, 5).Value
If ActiveCell.Value = "TITLE" Then titel = ActiveCell.Offset(0, 5).Value
If ActiveCell.Value = "OPTION" Then
x = x + 1
ta(x) = ActiveCell.Offset(0, 3).Value
tb(x) = ActiveCell.Offset(0, 4).Value
tc(x) = ActiveCell.Offset(0, 5).Value
td(x) = ActiveCell.Offset(0, 7).Value
te(x) = ActiveCell.Offset(0, 8).Value
End If
ActiveCell.Offset(1, 0).Select
Wend
ActiveWorkbook.Close
Workbooks.Open Filename:="Template.xls"
'Festlegen welcher Bereich als Seitenüberschrift genommen werden soll
kopf = ""
Set foundpos = ActiveSheet.Range("A:E").Find(What:="#End Header#", LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=True)
If Not foundpos Is Nothing Then
kopf = Range(Cells(1, 1), foundpos.Offset(-1, 4)).Address
foundpos.Activate
ActiveCell.EntireRow.Delete
End If
'Eintragen Konfiguration
[a1].Select
Set foundpos = ActiveSheet.Range("A:E").Find(What:="#Start Konfig#", LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=True)
If Not foundpos Is Nothing Then
If kopf = "" Then
' hier wird festgelegt was alles Überschrift sein soll -
' Vorgabe ist alles bis zur ersten Konfigurationszeile
kopf = Range(Cells(1, 1), foundpos.Offset(0, 4)).Address
End If
foundpos.Activate
StartKonfigRow = ActiveCell.Row
For i = 1 To x
ActiveCell.EntireRow.Insert
ActiveCell.Value = ta(i)
Selection.Font.FontStyle = "Bold"
'Selection.Font.FontStyle = "Fett"
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(1, 0).Value = tb(i)
ActiveCell.Offset(1, 1).Value = tc(i)
If td(i) > 0 Then
ActiveCell.Offset(1, 2).Value = te(i)
ActiveCell.Offset(1, 3).Value = td(i)
ActiveCell.Offset(1, 3).NumberFormat = "#,##0.00"
End If
ActiveCell.Offset(2, 0).EntireRow.Insert
ActiveCell.Offset(3, 0).Select
Next i
End If
Set foundpos = ActiveSheet.Range("A:E").Find(What:="#End Konfig#", LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=True)
If Not foundpos Is Nothing Then
While ActiveCell.Row() Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen