Excel VBA Anwendung Makro auf 2 Tabellenblätter

'################### Start Report: Risikobeurteilung ###################

Sub TabellenBlätter()
'Anzahl der Tabellenblätter ermitteln
Dim Anzahl As Long
Anzahl = ThisWorkbook.Worksheets.Count = Anzahl = ThisWorkbook.Sheets.Count
'Tabellenblätter mit dem Index ansprechen
Dim i As Long
For i = 1 To 2
'Name des aktuellen Tabellenblattes ausgeben
Call AktionAusführen(ThisWorkbook.Worksheets(i))
Next i
End Sub
Sub AktionAusführen 
'textfields for selections
Dim HazardNumber As String
Dim HazardNumberMain As String
Dim HazardNumber
Sub As String
Dim PhasesOfLifeCycle As String
Dim RiskReductionBy As String
Dim RowsPrinted As Integer
RowsPrinted = 0
For CurrentRow = 1 To Table_RiskAssessment.Range("Table_RiskAssessment").Rows.Count
'checking if line needs to be printed
RowNeedsToBePrinted = True
SelectedColumn = Table_RiskAssessment.Range("RAColl_HazardExists").column
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow, SelectedColumn). _
_
_
_
_
_
_
_
_
_
_
_
_
Value = "-" Then
RowNeedsToBePrinted = False
End If
If Table_RiskAssessment.Range("Table_RiskAssessment").Rows(CurrentRow).EntireRow.Hidden  _
_
_
_
_
_
_
_
_
_
_
_
_
= True Then
RowNeedsToBePrinted = False
End If
If RowNeedsToBePrinted = True Then
'setting up Textfields from selections
'Textfield: HazardNumber
HazardNumberMain = Table_RiskAssessment.Range("Table_RiskAssessment").Cells( _
CurrentRow, Table_RiskAssessment.Range("RAColl_NumberMain").column).Value
HazardNumber

Sub = Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow, Table_RiskAssessment. _
_
_
_
_
_
_
_
_
_
_
_
_
Range("RAColl_NumberSub").column).Value
If HazardNumberMain = "" Then
If HazardNumber

Sub = "" Then
HazardNumber = ""
Else
HazardNumber = "0" & HazardNumberSeparator & " " & HazardNumberSub
End If
Else
If HazardNumber

Sub = "" Then
HazardNumber = HazardNumberMain & HazardNumberSeparator & " 0"
Else
HazardNumber = HazardNumberMain & HazardNumberSeparator & " " &  _
HazardNumberSub
End If
End If
'Textfield: PhasesOfLifeCycle
PhasesOfLifeCycle = ""
SelectedColumn = Table_RiskAssessment.Range("RAColl_PhaseOfLifeCycle_All").column
If Not Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
PhasesOfLifeCycle = Table_Language.Range("text_LifeCycles_all").Value
Else
'checking every field individually, so that deleted fields can be skipped ( _
throws error here, needs to be deleted by hand right now)
SelectedColumn = Table_RiskAssessment.Range("RAColl_PhaseOfLifeCycle_Transport") _
_
_
_
_
_
_
_
_
_
_
_
_
.column
If Not Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
PhasesOfLifeCycle = PhasesOfLifeCycle & Table_Language.Range(" _
text_LifeCycles_transport").Value & "; "
End If
SelectedColumn = Table_RiskAssessment.Range("RAColl_PhaseOfLifeCycle_Assembly"). _
_
_
_
_
_
_
_
_
_
_
_
_
column
If Not Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
PhasesOfLifeCycle = PhasesOfLifeCycle & Table_Language.Range(" _
text_LifeCycles_assembly").Value & "; "
End If
SelectedColumn = Table_RiskAssessment.Range("RAColl_PhaseOfLifeCycle_Setting").  _
_
_
_
_
_
_
_
_
_
_
_
_
column
If Not Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
PhasesOfLifeCycle = PhasesOfLifeCycle & Table_Language.Range(" _
text_LifeCycles_setting").Value & "; "
End If
SelectedColumn = Table_RiskAssessment.Range("RAColl_PhaseOfLifeCycle_Operation") _
_
_
_
_
_
_
_
_
_
_
_
_
.column
If Not Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
PhasesOfLifeCycle = PhasesOfLifeCycle & Table_Language.Range(" _
text_LifeCycles_operation").Value & "; "
End If
SelectedColumn = Table_RiskAssessment.Range("RAColl_PhaseOfLifeCycle_Cleaning"). _
_
_
_
_
_
_
_
_
_
_
_
_
column
If Not Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
PhasesOfLifeCycle = PhasesOfLifeCycle & Table_Language.Range(" _
text_LifeCycles_cleaning").Value & "; "
End If
SelectedColumn = Table_RiskAssessment.Range(" _
RAColl_PhaseOfLifeCycle_FaultFinding").column
If Not Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
PhasesOfLifeCycle = PhasesOfLifeCycle & Table_Language.Range(" _
text_LifeCycles_faultfinding").Value & "; "
End If
SelectedColumn = Table_RiskAssessment.Range(" _
RAColl_PhaseOfLifeCycle_Dismantling").column
If Not Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
PhasesOfLifeCycle = PhasesOfLifeCycle & Table_Language.Range(" _
text_LifeCycles_dismantling").Value & "; "
End If
'cutting away the last "; " if any exists
If Len(PhasesOfLifeCycle) > 2 Then
PhasesOfLifeCycle = Left(PhasesOfLifeCycle, Len(PhasesOfLifeCycle) - 2)
End If
End If
'Textfield: RiskReductionBy
RiskReductionBy = ""
For j = 1 To Table_RiskAssessment.Range("RAColl_RiskReduction_By").Columns.Count
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskReduction_By").column +  _
_
_
_
_
_
_
_
_
_
_
_
_
i - 1
If Not Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
RiskReductionBy = RiskReductionBy & Table_RiskAssessment.Range(" _
RAColl_RiskReduction_By").Cells(3, i).Value & "; "
End If
Next
If Len(RiskReductionBy) > 2 Then
RiskReductionBy = Left(RiskReductionBy, Len(RiskReductionBy) - 2)
End If
'Textfield EHSR is applied "x" or unknown "?"
EHSRValue_Col = wdColorAutomatic                                        'Const  _
wdColorAutomatic    -16777216
SelectedColumn = Table_RiskAssessment.Range("RAColl_HazardExists").column
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "x" Then
EHSRValue = Table_Language.Range("text_applies").Value 'trifft zu
ElseIf Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "?" Then
EHSRValue = Table_Language.Range("text_toBeDecided").Value 'muss noch  _
entschieden werden
EHSRValue_Col = ColRe
End If
'Textfield Hazard covered by applied Standard
SelectedColumn = Table_RiskAssessment.Range("RAColl_ContentAlreadyCovered").column
HazardCovered_Col = wdColorAutomatic
HazardCovered_Bool = False
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "x" Then
HazardCovered = Table_Language.Range("text_covered").Value 'Inhalt ist abgedeckt  _
_
_
_
_
_
_
_
_
_
_
_
_
/ erledigt
HazardCovered_Bool = True
Else
HazardCovered = Table_Language.Range("text_mustBeConsidered").Value 'muss  _
behandelt werden
HazardCovered_Col = ColRe
End If
'################################################################################### _
_
_
_
_
_
_
_
_
_
_
_
_
'printing each column as one page in Word
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing headline
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
With wd
'##GSA##
.Selection.typetext Text:=Table_Language.Range("text_EHSR").Value 'EHSR  _
longform
.Selection.Style = wd.ActiveDocument.Styles("GSA")
.Selection.TypeParagraph   'Absatz einfügen
SelectedColumn = Table_RiskAssessment.Range("RAColl_EHSRNumber").column
selectedColumn2 = Table_RiskAssessment.Range("RAColl_EHSRTitle").column
.Selection.typetext Text:=Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value _
& " " & Table_RiskAssessment.Range(" _
Table_RiskAssessment").Cells(CurrentRow, selectedColumn2).Value 'EHSR Number + Title
.Selection.Style = wd.ActiveDocument.Styles("myHeadline 2")
.Selection.TypeParagraph   'Absatz einfügen
End With
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 1st table with general information
With wd
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 2, 4 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
With WS.Tables(TabNr) 'Tabelle anpassen
.cell(1, 1).Range.Text = Table_Language.Range("text_HazardExists").Value 'Gefä   _
_
_
_
_
_
_
_
_
_
_
_
_
hrdung vorhanden:
.cell(2, 1).Range.Text = EHSRValue
.cell(2, 1).Range.Font.Color = EHSRValue_Col
'new since 2.6
'only print text_EHSRcoveredByStandard if it is covered
'else this is unnecessary
If HazardCovered_Bool Then
.cell(1, 2).Range.Text = Table_Language.Range("text_EHSRcoveredByStandard"). _
_
_
_
_
_
_
_
_
_
_
_
_
Value 'Inhalt bereits abgedeckt
.cell(2, 2).Range.Text = HazardCovered
.cell(2, 2).Range.Font.Color = HazardCovered_Col
End If
'##Gefährdungsnummer##
.cell(1, 3).Range.Text = Table_Language.Range("text_UID").Value
.cell(2, 3).Range.Text = HazardNumber
'##Änderungsdatum##
.cell(1, 4).Range.Text = Table_Language.Range("text_DateOfLastChange").Value '   _
_
_
_
_
_
_
_
_
_
_
_
_
Datum der letzten Änderung:"
SelectedColumn = Table_RiskAssessment.Range("RAColl_LastChange").column
.cell(2, 4).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 2nd table: standard information
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_HazardAccordingToStandard") _
_
_
_
_
_
_
_
_
_
_
_
_
.Value 'Gefährdungen nach (harmonisierter) Norm
.Selection.Style = wd.ActiveDocument.Styles("myHeadline 3")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 9, 2 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables. _
Count
With WS.Tables(TabNr) 'Tabelle anpassen
.cell(1, 1).Range.Text = Table_Language.Range("text_StandardNumber").Value & ",  _
_
_
_
_
_
_
_
_
_
_
_
_
" & Table_Language.Range("text_StandardTitle").Value 'Norm Nummer, Norm Titel
'Abschnitt / Detail:
.cell(2, 1).Range.Text = Table_Language.Range("text_StandardSubclause").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_StandardSubclause").column
.cell(2, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
'Norminhalt (eingekürzt und bearbeitet)
.cell(3, 1).Range.Text = Table_Language.Range("text_StandardContent").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_StandardContent").column
.cell(3, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
'Ursprung:
.cell(4, 1).Range.Text = Table_Language.Range("text_StandardOrigin").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_StandardOriginOfHazard"). _
column
.cell(4, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
'mögliche Auswirkung:
.cell(5, 1).Range.Text = Table_Language.Range("text_StandardPotentialConseq").   _
_
_
_
_
_
_
_
_
_
_
_
_
Value
SelectedColumn = Table_RiskAssessment.Range(" _
RAColl_StandardConsequencesOfHazard").column
.cell(5, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
'Ort / Gefahrbereich / Position in Zeichnung:
.cell(6, 1).Range.Text = Table_Language.Range("text_StandardPlace").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_Place").column
.cell(6, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
'Gefährdung / Gefährdungssituation:
.cell(7, 1).Range.Text = Table_Language.Range("text_StandardHazard").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_Hazard").column
.cell(7, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
'Gefährdete Personen:
.cell(8, 1).Range.Text = Table_Language.Range("text_StandardPersonInDanger"). _
Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_PersonInDanger").column
.cell(8, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
'Lebensphase (nach EN ISO 12100, Tabelle B.3):
.cell(9, 1).Range.Text = Table_Language.Range("text_LifeCycle").Value
.cell(9, 2).Range.Text = PhasesOfLifeCycle
End With
'Normnummer und Normtext mit Absatz trennen
SelectedColumn = Table_RiskAssessment.Range("RAColl_StandardNumber").column
selectedColumn2 = Table_RiskAssessment.Range("RAColl_StandardTitle").column
'Norm schreiben überspringen, wenn keine Norm angegeben ist
If Not (Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" _
Or Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "---") Then
'Makro in Word starten: Norm schreiben
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
selectedColumn2).Text = "#NV" Then      ' .Text necessary to prevent type mismatch with error    _
_
_
_
_
_
_
_
_
_
_
_
messages
wd.Run "Norm_Schreiben", _
Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value, _
Else
wd.Run "Norm_Schreiben", _
Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value, _
Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
selectedColumn2).Text       ' .Text necessary to prevent type mismatch with error messages
End If
End If
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 3rd table: risk estimation before
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_RiskEstimationBefore"). _
Value
.Selection.Style = wd.ActiveDocument.Styles("BeText")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 2, 5 'Makro in Word starten: Tabelle anlegen
End With
'Auswertung Risikostufe für Hintergrundfarbe
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskBefore_Risk").column
RB_Summe = Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value
If RB_Summe = "a" Then
RB_Color = ColGr
ElseIf RB_Summe = "b" Then
RB_Color = ColHGr
ElseIf RB_Summe = "c" Then
RB_Color = ColYe
ElseIf RB_Summe = "d" Then
RB_Color = ColHRe
ElseIf RB_Summe = "e" Then
RB_Color = ColRe
Else
RB_Color = ColDef
End If
OWillBeSet = False
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
With WS.Tables(TabNr) 'Tabelle anpassen
'Schwere der Verletzung (S)
.cell(1, 1).Range.Text = Table_Language.Range("text_RiskEstimationS").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskBefore_S").column
.cell(2, 1).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
If Not (Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "") Then
OWillBeSet = True
End If
'Häufigkeit (F)
.cell(1, 2).Range.Text = Table_Language.Range("text_RiskEstimationF").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskBefore_F").column
.cell(2, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
If Not (Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "") Then
OWillBeSet = True
End If
'Möglichkeit der Vermeidung (P)
.cell(1, 3).Range.Text = Table_Language.Range("text_RiskEstimationP").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskBefore_P").column
.cell(2, 3).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
If Not (Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "") Then
OWillBeSet = True
End If
'Wahrscheinlichkeit (W)
.cell(1, 4).Range.Text = Table_Language.Range("text_RiskEstimationO").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskBefore_W").column
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" And OWillBeSet Then
.cell(2, 4).Range.Text = defaultValueForO 'default Value for O = "2"
Else
.cell(2, 4).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
_
_
_
_
_
_
_
_
_
_
_
_
Cells(CurrentRow, SelectedColumn).Value
End If
'Risiko
.cell(1, 5).Range.Text = Table_Language.Range("text_RiskEstimationRisk").Value
.cell(2, 5).Range.Text = RB_Summe
.cell(2, 5).Shading.BackgroundPatternColor = RB_Color
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 4th table: protective measures
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_RiskReduction").Value  ' _
Risikominimierung
.Selection.Style = wd.ActiveDocument.Styles("myHeadline 3")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_protectiveMeasure").Value   _
_
_
_
_
_
_
_
_
_
_
_
_
'Schutzmaßnahme
.Selection.Style = wd.ActiveDocument.Styles("BeText")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 1, 1 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
With WS.Tables(TabNr) 'Tabelle anpassen
.cell(1, 1).Range.Text = RiskReductionBy
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 5th table: risk reduction description
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_DescriptionOfReduction").   _
_
_
_
_
_
_
_
_
_
_
_
_
Value
.Selection.Style = wd.ActiveDocument.Styles("BeText")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 1, 1 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
With WS.Tables(TabNr) 'Tabelle anpassen
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskReduction_Description"). _
_
_
_
_
_
_
_
_
_
_
_
_
column
.cell(1, 1).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 6th table: standard risk reduction
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_appliedStandardNumber"). _
Value
.Selection.Style = wd.ActiveDocument.Styles("BeText")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 2, 2 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
With WS.Tables(TabNr) 'Tabelle anpassen
.cell(1, 1).Range.Text = Table_Language.Range("text_appliedStandardNumber"). _
Value
.cell(2, 1).Range.Text = Table_Language.Range("text_appliedStandardSubclause").  _
_
_
_
_
_
_
_
_
_
_
_
_
Value
SelectedColumn = Table_RiskAssessment.Range(" _
RAColl_RiskReduction_AppliedStandardSubclause").column
.cell(2, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
End With
'Normnummer und Normtext mit Absatz trennen
SelectedColumn = Table_RiskAssessment.Range(" _
RAColl_RiskReduction_AppliedStandardNumber").column
selectedColumn2 = Table_RiskAssessment.Range(" _
RAColl_RiskReduction_AppliedStandardTitle").column
'Norm schreiben überspringen, wenn keine Norm angegeben ist
If Not (Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" _
Or Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "---") Then
'Makro in Word starten: Norm schreiben
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
selectedColumn2).Text = "#NV" Then      ' .Text necessary to prevent type mismatch with error    _
_
_
_
_
_
_
_
_
_
_
_
messages
wd.Run "Norm_Schreiben", _
Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value, _
Else
wd.Run "Norm_Schreiben", _
Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value, _
Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
selectedColumn2).Text       ' .Text necessary to prevent type mismatch with error messages
End If
End If
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 7th table: solution by safety function
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_SafetyFunction").Value
.Selection.Style = wd.ActiveDocument.Styles("BeText")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 1, 1 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
With WS.Tables(TabNr) 'Tabelle anpassen
SelectedColumn = Table_RiskAssessment.Range(" _
RAColl_RiskReduction_SafetyFunction").column
.cell(1, 1).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 8th table: validation
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_Verificationfile").Value
.Selection.Style = wd.ActiveDocument.Styles("BeText")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 1, 1 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
With WS.Tables(TabNr) 'Tabelle anpassen
SelectedColumn = Table_RiskAssessment.Range(" _
RAColl_RiskReduction_VerificationFile").column
.cell(1, 1).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 9th table: validation
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_technicalReport").Value
.Selection.Style = wd.ActiveDocument.Styles("BeText")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 1, 1 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
With WS.Tables(TabNr) 'Tabelle anpassen
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskReduction_ReportFile").  _
_
_
_
_
_
_
_
_
_
_
_
_
column
.cell(1, 1).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 10th table: risk after
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_RiskEstimationAfter"). _
Value
.Selection.Style = wd.ActiveDocument.Styles("BeText")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 2, 5 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskAfter_Risk").column
RB_Summe = Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value
If RB_Summe = "a" Then
RB_Color = ColGr
ElseIf RB_Summe = "b" Then
RB_Color = ColHGr
ElseIf RB_Summe = "c" Then
RB_Color = ColYe
ElseIf RB_Summe = "d" Then
RB_Color = ColHRe
ElseIf RB_Summe = "e" Then
RB_Color = ColRe
Else
RB_Color = ColDef
End If
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
OWillBeSet = False
With WS.Tables(TabNr) 'Tabelle anpassen
'Schwere der Verletzung (S)
.cell(1, 1).Range.Text = Table_Language.Range("text_RiskEstimationS").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskAfter_S").column
.cell(2, 1).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
If Not (Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "") Then
OWillBeSet = True
End If
'Häufigkeit (F)
.cell(1, 2).Range.Text = Table_Language.Range("text_RiskEstimationF").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskAfter_F").column
.cell(2, 2).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
If Not (Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "") Then
OWillBeSet = True
End If
'Möglichkeit der Vermeidung (P)
.cell(1, 3).Range.Text = Table_Language.Range("text_RiskEstimationP").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskAfter_P").column
.cell(2, 3).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
If Not (Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "") Then
OWillBeSet = True
End If
'Wahrscheinlichkeit (W)
.cell(1, 4).Range.Text = Table_Language.Range("text_RiskEstimationO").Value
SelectedColumn = Table_RiskAssessment.Range("RAColl_RiskAfter_W").column
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" And OWillBeSet Then
.cell(2, 4).Range.Text = defaultValueForO 'default Value for O = "2"
Else
.cell(2, 4).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
_
_
_
_
_
_
_
_
_
_
_
_
Cells(CurrentRow, SelectedColumn).Value
End If
'Risiko
.cell(1, 5).Range.Text = Table_Language.Range("text_RiskEstimationRisk").Value
.cell(2, 5).Range.Text = RB_Summe
.cell(2, 5).Shading.BackgroundPatternColor = RB_Color
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 11th table: Comment
With wd
'.Selection.TypeParagraph   'Absatz einfügen
.Selection.typetext Text:=Table_Language.Range("text_comment").Value
.Selection.Style = wd.ActiveDocument.Styles("BeText")
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 1, 1 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
With WS.Tables(TabNr) 'Tabelle anpassen
SelectedColumn = Table_RiskAssessment.Range("RAColl_Comment").column
.cell(1, 1).Range.Text = Table_RiskAssessment.Range("Table_RiskAssessment"). _
Cells(CurrentRow, SelectedColumn).Value
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'printing 12th table:
With wd
.Selection.TypeParagraph   'Absatz einfügen
.Selection.Style = wd.ActiveDocument.Styles("TabText")
.Run "Tab_Anlegen", 2, 3 'Makro in Word starten: Tabelle anlegen
End With
TabNr = wd.ActiveDocument.Range(0, wd.Selection.Tables(1).Range.End).Tables.Count
SelectedColumn = Table_RiskAssessment.Range("RAColl_FurtherReductionNecessary"). _
column
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "x" Then
WRed = Table_Language.Range("text_mustBeConsidered").Value 'weitere Reduzierung  _
_
_
_
_
_
_
_
_
_
_
_
_
notwendig
Wred_Color = ColRe
ElseIf Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "-" Then
WRed = Table_Language.Range("text_noFurtherReduction").Value 'keine weitere  _
Reduzierung notwendig
Wred_Color = wdColorAutomatic
Else
WRed = Table_Language.Range("text_provideInformation").Value 'BITTE ANGABEN  _
MACHEN!
Wred_Color = ColRe
End If
SelectedColumn = Table_RiskAssessment.Range("RAColl_HazardCovered").column
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "x" Then
GefBe = Table_Language.Range("text_EHSRcovered").Value 'behandelt / betrachtet,  _
_
_
_
_
_
_
_
_
_
_
_
_
Zeile ist fertig
GefBe_Color = wdColorAutomatic
Else
GefBe = Table_Language.Range("text_EHSRnotCovered").Value 'Nicht behandelt /  _
betrachtet, Zeile muss noch bearbeitet werden
GefBe_Color = ColRe
End If
SelectedColumn = Table_RiskAssessment.Range("RAColl_PersonInCharge").column
If Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,  _
SelectedColumn).Value = "" Then
BearbRB = Table_Language.Range("text_provideInformation").Value 'BITTE ANGABEN   _
_
_
_
_
_
_
_
_
_
_
_
_
MACHEN!
BearbRB_Color = ColRe
Else
BearbRB = Table_RiskAssessment.Range("Table_RiskAssessment").Cells(CurrentRow,   _
_
_
_
_
_
_
_
_
_
_
_
_
SelectedColumn).Value
BearbRB_Color = wdColorAutomatic
End If
With WS.Tables(TabNr) 'Tabelle anpassen
.cell(1, 1).Range.Text = Table_Language.Range("text_FurtherReductionNecessary"). _
_
_
_
_
_
_
_
_
_
_
_
_
Value 'Weitere Reduzierung notwendig?"
.cell(2, 1).Range.Text = WRed
.cell(2, 1).Range.Font.Color = Wred_Color
.cell(1, 2).Range.Text = Table_Language.Range("text_PersonInCharge").Value ' _
Bearbeiter
.cell(2, 2).Range.Text = BearbRB
.cell(2, 2).Range.Font.Color = BearbRB_Color
.cell(1, 3).Range.Text = Table_Language.Range("text_HazardCovered").Value 'Gefä  _
_
_
_
_
_
_
_
_
_
_
_
_
hrdung ist behandelt?
.cell(2, 3).Range.Text = GefBe
.cell(2, 3).Range.Font.Color = GefBe_Color
End With
Call nTab(WS, wd) 'zu Textmarke wechseln / nächste Einfügestelle
'----------------------------------------------------------------------------------- _
_
_
_
_
_
_
_
_
_
_
_
_
'finished last table
RowsPrinted = RowsPrinted + 1
With FormPrinting
.UpdateProgressbar 6 + RowsPrinted
.Label_LinesPrintedNumber.Caption = RowsPrinted
End With
End If 'end of table not printed
Next 'CurrentRow
'Activating Excel before opening Word
'else Excel might not get reactivated
Application.Interactive = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.StatusBar = False
ThisWorkbook.Activate
WS.Bookmarks("File_Start").Select
With wd
.Run "AlleFldAktualisieren"
.Visible = True 'Dokument anzeigen
.WindowState = 1
End With
Beep
If ActivateWord(wd) = False Then
MsgBox Table_Language.Range("message_ReportPrinted").Value, vbOKOnly, Table_Language. _
Range("message_BoxPrintRA").Value
End If
Unload FormPrinting
Set wd = Nothing
Set WS = Nothing
End Sub
Sub WordTableWriter(WS, WordTableName, ExcelTableName, ExcelSheetName)
'# MBT-Makro                                                         #
'# DiesesMakro schreibt alle Daten einer Exeltabelle in die          #
'# entsprechende Wordtabelle                                         #
'# i/o ws: Wordobjekt mit Dokument                                   #
'# i/o WordTableName: Ziel Tabelle                                   #
'# i/o ExcelTableName: Quell Tabelle                                 #
'# i/o ExcelSheetName: Quell Blatt                                   #
Dim MyRows As Integer ': Zeilenzahl der Tabelle
Dim MyCols As Integer ': Spaltenzahl der Tabelle
'Dim WordTable As Table
Dim rowcounter As Integer
Dim colcounter As Integer
MyRows = ExcelSheetName.Range(ExcelTableName).Rows.Count
MyCols = ExcelSheetName.Range(ExcelTableName).Columns.Count
'WordTable = WS.Bookmarks(WordTableName).Range.Tables(1)
For rowcounter = 1 To (MyRows)
For colcounter = 1 To (MyCols)
On Error Resume Next                                'sloppy programming, needs to    _
_
_
_
_
_
_
_
_
_
_
_
_
skip cells that don't exist cause of merging
'need to find a clean way to  _
test cells for existance
With WS.Bookmarks(WordTableName).Range.Tables(1)
.cell(rowcounter, colcounter).Range.Text = ExcelSheetName.Range(ExcelTableName). _
_
_
_
_
_
_
_
_
_
_
_
_
Cells(rowcounter, colcounter).Value
End With
On Error GoTo 0                                     'reactivates error handling
Next
Next
End Sub
Sub nTab(WS, wd)
'# MBT-GbR
'# Dieses Makro spingt in Word an das Ende der Datei
'# = nächste Einfügestelle für die nächste Tabelle
 wd.Selection.endkey 6, 0
End Sub