AW: Dazu müsste man den Code und die Mappe kennen
27.11.2009 18:41:07
Andreas
hier der gesamte code:
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:="C:\JDApps\Pricebook\Export\Template.xls"
'Festlegen welcher Bereich als Seitenüberschrift genommen werden soll
kopf = ""
Set foundpos = ActiveSheet.Range("A:E").Find(What:="#End Header#", LookIn:=xlValue, 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:=xlValue, 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:=xlValue, LookAt:= _
xlWhole, MatchCase:=True)
If Not foundpos Is Nothing Then
While ActiveCell.Row()