Sub
Schaltfläche10_Internen_Auftrag_erstellen()
Dim
lrow
As
Long
Dim
lzeile
As
Long
Dim
vntin
As
Variant
Dim
vntPers
As
Variant
Dim
i%, j
As
Integer
Dim
dteStart
As
Date
Dim
dteEnde
As
Date
Dim
blnstart
As
Boolean
vntPers = Cells(ActiveCell.Row, 1).Resize(, 26).Value
lzeile = Fix((ActiveCell.Row - 10) / 38) * 38 + 7
i = 6
While
i < 26
If
Len(vntPers(1, i)) > 0
Then
If
Not
blnstart
Then
dteStart = Cells(lzeile, i)
j = i
blnstart =
True
End
If
dteEnde = Cells(lzeile, i)
End
If
i = i + 3
Wend
With
Worksheets(
"Projektübersicht"
)
lrow = WorksheetFunction.Match(Cells(ActiveCell.Row, 1), .Columns(1), 0)
vntin = .Cells(lrow, 1).Resize(, 46).Value
End
With
i =
CInt
(InputBox(
"bitte Nr. des Verantwortlichen eingeben "
& vbLf &
"oberster Eintrag = 1 usw "
,
"Verantwortung übernimmt Nr..."
, 1))
With
Sheets(
"Interner Auftrag"
)
.Cells(2, 2) = Cells(ActiveCell.Row, 1)
.Cells(5, 2) = vntin(1, 3)
.Cells(7, 4) = vntin(1, 3)
.Cells(5, 7) = vntin(1, 9)
.Cells(5, 5) = vntin(1, 33)
.Cells(6, 3) = vntin(1, 38)
.Cells(6, 5) = vntin(1, 39)
.Cells(6, 6) = vntin(1, 40)
.Cells(8, 4) = vntin(1, 5) &
"/"
& vntin(1, 6)
.Cells(9, 4) = vntin(1, 7)
.Cells(11, 4) = vntin(1, 8) &
"/"
& vntin(1, 9)
.Cells(5, 7) = vntin(1, 9)
.Cells(11, 5) = vntin(1, 14)
.Cells(10, 4) = vntin(1, 16) &
"/"
& vntin(1, 17)
.Cells(12, 4) = vntin(1, 38) &
"/"
& vntin(1, 33)
.Cells(12, 5) = vntin(1, 39)
.Cells(10, 5) = vntin(1, 22)
.Cells(22, 2) = vntin(1, 45)
.Cells(23, 2) = vntin(1, 44)
.Cells(24, 2) = vntin(1, 38)
.Cells(19, 5) = vntin(1, 43)
.Cells(22, 3) =
"Freitext Interner Auftrag:"
& vbCrLf & vntin(1, 46)
.Cells(14, 5) = vntPers(1, j + 1)
.Cells(13, 3) = dteStart &
" - "
& dteEnde
.Cells(14, 3) = vntPers(1, j)
.Cells(19, 3) = vntin(1, 31)
.Cells(14, 7) = IIf(UBound(Split(vntPers(1, j), Chr(10))) > 0, Split(vntPers(1, j), Chr(10))(i - 1), vntPers(1, j))
.Cells(63, 4) =
"Ladestraße, Calau"
.Cells(63, 6) = vntin(1, 7) &
", "
& vntin(1, 5) &
" "
& vntin(1, 6)
.Cells(19, 1) =
"Information zum Schaden/ Beschädigung:"
& vbCrLf & vntin(1, 31)
If
vntin(1, 29) =
"X"
Then
.Cells(61, 1) =
"Die Unterkunft ist gebucht. Die Buchungsunterlagen wurden den entsprechenden Mitarbeitern weiter geleitet"
If
vntin(1, 30) =
"X"
Then
.Cells(62, 1) =
"Der Flug ist gebucht. Die Buchungsunterlagen wurden den entsprechenden Mitarbeitern weiter geleitet"
If
vntin(1, 29) =
""
Then
.Cells(61, 1) =
"Keine Unterkunft gebucht!"
If
vntin(1, 30) =
""
Then
.Cells(62, 1) =
"Kein Flug gebucht!"
End
With