Platziert mit einem Eimer Wasser oberhalb, dann kannst du rauf fahren.
Ich kann dort nur eine 5 erkennen, das andere könnte auch nur ein Kürzel des Kontrolleurs sein.
In Spalte B steht das Datum 01.01.-31.12. In C wenn Raum 1 belegt ist, D wenn Raum 4 belegt ist. In E stehen die Veranstaltungen mit datum, F der Raum und H der Nutzer. Nun soll in C und D ausgegeben werden wer an dem Tag welchen Raum nutzt. Momentan wird mir nur 0 für nicht belegt und 1 für belegt angezeigt, ich hätte aber gerne, dass am 04.01.2019 im Raum 1 "Mieter 1" angezeigt wird statt einer 1.
Option Explicit
Const strBookmark1 As String = "AnName"
Const strBookmark2 As String = "AnAdresse"
Const strBookmark3 As String = "AnPLZOrt"
Const strBookmark4 As String = "Datum1"
Const strBookmark5 As String = "Datum2"
Const strBookmark6 As String = "Rechnungsnummer"
Const strBookmark7 As String = "Nutzer"
Const strBookmark8 As String = "Name"
Const strBookmark9 As String = "Anfang"
Const strBookmark10 As String = "Dauer"
Const strBookmark11 As String = "Person"
Const strBookmark12 As String = "Saal"
Const strBookmark13 As String = "MSaal"
Const strBookmark14 As String = "MParken"
Const strBookmark15 As String = "Storno"
Const strBookmark16 As String = "Summe"
Const strBookmark17 As String = "Zahlung"
Const wdDialogFileSaveAs = 84
Dim blnTMP As Boolean
Public Sub Main()
Variablen
Dim objWordRange As Object
Dim objDocument As Object
Dim objDialog As Object
Dim objApp As Object
Dim strDoc As String
On Error GoTo Fin
strDoc = ThisWorkbook.Path & _
Application.PathSeparator & ("Rechnung.dotx")
Set objApp = OffApp("Word")
If Not objApp Is Nothing Then
Objektvariable objDocument
Set objDocument = objApp.Documents.Open(Filename:=strDoc)
With ThisWorkbook.Worksheets("Termine Veranstaltungen")
If objDocument.Bookmarks.Exists(strBookmark1) = True Then
objDocument.Bookmarks(strBookmark1).Range = .Range("t1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark2) = True Then
objDocument.Bookmarks(strBookmark2).Range = .Range("u1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark3) = True Then
objDocument.Bookmarks(strBookmark3).Range = .Range("v1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark4) = True Then
objDocument.Bookmarks(strBookmark4).Range = .Range("w1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark5) = True Then
objDocument.Bookmarks(strBookmark5).Range = .Range("a1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark6) = True Then
objDocument.Bookmarks(strBookmark6).Range = .Range("r1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark7) = True Then
objDocument.Bookmarks(strBookmark7).Range = .Range("b1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark8) = True Then
objDocument.Bookmarks(strBookmark8).Range = .Range("h1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark9) = True Then
objDocument.Bookmarks(strBookmark9).Range = .Range("e1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark10) = True Then
objDocument.Bookmarks(strBookmark10).Range = .Range("g1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark11) = True Then
objDocument.Bookmarks(strBookmark11).Range = .Range("i1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark12) = True Then
objDocument.Bookmarks(strBookmark12).Range = .Range("c1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark13) = True Then
objDocument.Bookmarks(strBookmark13).Range = .Range("x1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark14) = True Then
objDocument.Bookmarks(strBookmark14).Range = .Range("ah1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark15) = True Then
objDocument.Bookmarks(strBookmark15).Range = .Range("ai1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark16) = True Then
objDocument.Bookmarks(strBookmark16).Range = .Range("p1").Text
End If
If objDocument.Bookmarks.Exists(strBookmark17) = True Then
objDocument.Bookmarks(strBookmark17).Range = .Range("s1").Text
End If
Application.CutCopyMode = True
Set objWordRange = Nothing
Set objDialog = objApp.Dialogs(wdDialogFileSaveAs)
With objDialog
.Name = "C:\Users\Saalverwaltung\Desktop\Rechnungen 2018 blanko\2018\"
End With
End With
Else
MsgBox "Applikation nicht installiert!"
End If
Fin:
If Not objApp Is Nothing Then
If blnTMP = True Then
objApp.Quit
blnTMP = False
End If
End If
Set objWordRange = Nothing
Set objDocument = Nothing
Set objApp = Nothing
Application.CutCopyMode = True
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Private Function OffApp(ByVal strApp As String, _
Optional blnVisible As Boolean = True) As Object
Dim objApp As Object
On Error Resume Next
Set objApp = GetObject(, strApp & ".Application")
Select Case Err.Number
Case 429
Err.Clear
Set objApp = CreateObject(strApp & ".Application")
blnTMP = True
If blnVisible = True Then
On Error Resume Next
objApp.Visible = True
Err.Clear
End If
End Select
On Error GoTo 0
Set OffApp = objApp
Set objApp = Nothing
End Function
Ich habe für mich mal einen stundenverteiler im 4 Schicht System mit flexibler Zeit Einstellung und Berechnung der Zuschläge für 2016 erstellt.
Hier der link:
http://www.file-upload.net/download-11012741/Stundenverteiler2016Vorlage-1.xls.html