|
Guten Morgen,
hier ist der Code:Sub HP_erstellen()
' liest die variablen Daten eines HP aus dem jeweiligen Register "HP_Datenbank" und
' überträgt sie in das Register "HP"
'Call aufraeumen
Application.ScreenUpdating = False
Dim hp_daten_pos(300) As String ' enthält die Feldnamen
Dim hp_daten_hoehe(300) As Integer ' 0: wenn hpdaten(i)="" dann Zeilenhöhe = 0, 1: keine Aktion
Dim hp_daten(300) As String ' enthält die Feldinhalte
Dim register As String
' Namen des aktiven Registers bestimmen
register = ActiveSheet.name
Call ZeileSpalteBestimmen(ze, sp)
If register = "HP_Datenbank" And ze >= 5 Then
For ii = 1 To 300
hp_daten_pos(ii) = Cells(3, ii)
hp_daten_hoehe(ii) = Cells(4, ii)
hp_daten(ii) = Cells(ze, ii)
Next ii
Sheets("HP").Select
For ii = 1 To 300
If hp_daten_pos(ii) <> "" Then
Let Err = 0
On Error Resume Next
Range(hp_daten_pos(ii)).Select
If Err = 1004 Then MsgBox "Das Feld " & hp_daten_pos(ii) & " existiert nicht!"
On Error GoTo 0
Range(hp_daten_pos(ii)).Select
'
' wenn keine Daten und Höhe = 0, dann Zeilenhöhe auf 0 setzen
If hp_daten(ii) = "" And hp_daten_hoehe(ii) = 0 Then
ActiveCell.RowHeight = 0
' wenn <DEL>, dann Zeilenhöhe auf 0 setzen
ElseIf hp_daten(ii) = "<DEL>" Then
ActiveCell.RowHeight = 0
' Seitenumbruch einfügen: <PB> = PageBreak
ElseIf hp_daten(ii) = "<PB>" Then
Call ZeileSpalteBestimmen(ze2, sp2)
Rows(ze2).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Else
ActiveCell.Select
If Left(hp_daten(ii), 6) = "<FORM>" Then
hp_daten(ii) = Right(hp_daten(ii), Len(hp_daten(ii)) - 6)
ActiveCell.FormulaLocal = hp_daten(ii)
Else
ActiveCell.Value = hp_daten(ii)
End If
End If
End If
Next ii
SendKeys "(^{home})", True
Cells(3, 2).Select
End If
'Call FormelnErsetzen
Application.ScreenUpdating = True
End Sub
Vielen Dank und viele Grüße
|