Makros für Radiologen: Makro zum Report der Mammographie: Makro Mammographie: MGfrmZusatzA
Dieses Makro gehört zu Makro Mammographie – Kurzbeschreibung siehe Makro zum Report der Mammographie.
Option Explicit
Dim FEHLER As Variant
----
Private Sub chkDetailR_Click()
If (Me.chkDetailR.Value = True) Then
Me.fraLokalR.Enabled = True
End If
End Sub
----
Private Sub chkDetailL_Click()
If (Me.chkDetailL.Value = True) Then
Me.fraLokalL.Enabled = True
End If
End Sub
----
Private Sub cmdok_Click()
'auf Vollständigkeit prüfen
FEHLER = "" 'variable um bei Fehlern steuern zu können
'Rechts links
If (Me.optRS.Value = True) Or (Me.optLS.Value = True) Or _
(Me.optBds.Value = True) Then
If Me.optmlocc.Value = False And _
Me.optmlo.Value = False And _
Me.optml.Value = False And _
Me.optcc.Value = False Then
FEHLER = "Art"
End If
End If
If (Me.chkDetailR.Value = True) Then
If (Me.optObenR.Value = False) And _
(Me.optUntenR.Value = False) And _
(Me.optInnenR.Value = False) And _
(Me.optAussenR.Value = False) And _
(Me.optZentralR.Value = False) Then
FEHLER = FEHLER & "Lokalisationsangabe R "
End If
End If
If (Me.chkDetailL.Value = True) Then
If (Me.optObenL.Value = False) And _
(Me.optUntenL.Value = False) And _
(Me.optInnenL.Value = False) And _
(Me.optAussenL.Value = False) And _
(Me.optZentralL.Value = False) Then
FEHLER = FEHLER & "Lokalisationsangabe L "
End If
End If
'wenn fehler
If FEHLER <> "" Then
MsgBox FEHLER, vbCritical
Else
'Standard
If Me.optRS.Value = True Then MGAUFN = Chr$(13) & MGSONO & "Mammographie rechts "
If Me.optLS.Value = True Then MGAUFN = Chr$(13) & MGSONO & "Mammographie links "
If Me.optBds.Value = True Then MGAUFN = Chr$(13) & MGSONO & "Mammographie beidseits "
If Me.optmlocc.Value = True Then MGAUFN = MGAUFN & "mlo und cc vom " & _
MGUDATUM & ":" & vbCrLf
If Me.optmlo.Value = True Then MGAUFN = MGAUFN & "mlo vom " & _
MGUDATUM & ":" & vbCrLf
If Me.optml.Value = True Then MGAUFN = MGAUFN & "ml vom " & _
MGUDATUM & ":" & vbCrLf
If Me.optcc.Value = True Then MGAUFN = MGAUFN & "cc vom " & _
MGUDATUM & ":" & vbCrLf
'Zusatz
If Me.chkmlR.Value = True Or Me.chkmlL.Value = True Then
MGZUSATZ = " Zusatzaufnahme "
If Me.chkmlR.Value = True Then MGZUSATZ = MGZUSATZ & "ml rechts"
If Me.chkmlR.Value = True And Me.chkmlL.Value = True Then MGZUSATZ = MGZUSATZ & " und"
If Me.chkmlL.Value = True Then MGZUSATZ = MGZUSATZ & "ml links "
MGZUSATZ = MGZUSATZ & ". "
End If
If Me.chkDetailR.Value = True Or Me.chkDetailL.Value = True Then
MGZUSATZ = MGZUSATZ & " Detailvergrößerungsaufnahme "
If Me.optObenR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts oben"
If Me.optUntenR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts unten"
If Me.optInnenR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts innen"
If Me.optAussenR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts aussen"
If Me.optZentralR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts zentral"
If Me.chkDetailR.Value = True And Me.chkDetailL.Value = True Then MGZUSATZ = MGZUSATZ & " und "
If Me.optObenL.Value = True Then MGZUSATZ = MGZUSATZ & "links oben"
If Me.optUntenL.Value = True Then MGZUSATZ = MGZUSATZ & "links unten"
If Me.optInnenL.Value = True Then MGZUSATZ = MGZUSATZ & "links innen"
If Me.optAussenL.Value = True Then MGZUSATZ = MGZUSATZ & "links aussen"
If Me.optZentralL.Value = True Then MGZUSATZ = MGZUSATZ & "links zentral"
MGZUSATZ = MGZUSATZ & ". "
End If
Unload MGfrmZusatzA
End If 'wenn Fehler
End Sub
----
Private Sub UserForm_Initialize()
Me.fraLokalR.Enabled = False
Me.fraLokalL.Enabled = False
End Sub