AW: Hyperlink in Formel einbauen
17.07.2007 01:02:00
fcs
Hallo Gabi,
ich hab noch einmal ein wenig nachgedacht :-)
Das Makro fragt jetzt nach einander die Namen der Tabellen für die beiden Varianten (MitarbeiterStatus = NA/AWE oder HA) ab. Anschließend wird abhängig vom Eintrag in Spalte C die entsprechende Formel eingetragen.
Die Funktion RUNDEN hab ich mit eingebaut, da die interne Rechengenauigkeit von EXCEL (ca. 15 Stellen) manchmal dazu führt, dass scheinbar identische Werte von Excel als unterschiedlich betrachtet werden, weil sich in der 10. oder 12. Nachkomma-Stelle Differenzen ergeben. mit RUNDEN wird diese Problematik umgangen.
Vor der Makroausführung die Zellen in Spalte E markieren, damit Inhalte aus Spalte A und C korrekt ausgelesen werden.
Gruß
Franz
Sub HyperlinkFormeln_einfuegen()
' HyperlinkFormel Makro
' Fügt im Selektierten Zellenbereich Formeln ein wenn in der linken Nachbarzelle ein _
Hyperlink eingetragen ist
'=WENN(ISTFEHLER(DATWERT(TEXT('C:\Test\Daten\[Formular2.xls] _
Juni'!$C$24;"TT.MM.JJJJ")));"";"X")
Dim Monat$, Zelle As Range, Datei$, Formel$, PosLast%, AnzBackSlash%
Dim TypMA$, TabName$, Periode$
On Error GoTo FehlerCheck
Monat = InputBox("Name des Tabellenblattes für NA und AWE Mitarbeiter, " _
& "dass in die Formel eingetragen werden soll:", _
"Formeln für Hyperlink eintragen - NA- und AWE-Mitarbeiter", _
Format(DateSerial(Year(Date), Month(Date), 0), "MMM") & "-Meldg")
If Monat = "" Then Exit Sub 'Button Abbrechen wurde gewählt
Periode = InputBox("Name des Tabellenblattes für HA-Mitarbeiter, " _
& "dass in die Formel eingetragen werden soll:", _
"Formeln für Hyperlink eintragen - HA-Mitarbeiter", _
"16.07.-12.08.")
If Periode = "" Then Exit Sub 'Button Abbrechen wurde gewählt
For Each Zelle In Selection
'Prüfen ob Nachbar-Zelle 4 Spaltem nach links Hyperlink hat
If Zelle.Offset(0, -4).Hyperlinks.Count > 0 Then
'Position rechten Backslash ermitteln
Datei = Zelle.Offset(0, -4).Hyperlinks(1).Address
With Application.WorksheetFunction
AnzBackSlash = Len(Datei) - Len(.Substitute(Datei, "\", ""))
Formel = .Substitute(Datei, "\", "XZZY", AnzBackSlash)
PosLast = InStr(1, Formel, "XZZY")
End With
TypMA = Zelle.Offset(0, -2) 'Typ Mitarbeiter/Mitarbeiterin
Select Case TypMA 'Typ Mitarbeiter/Mitarbeiterin
Case "NA", "AWE"
TabName = Monat
Case "HA"
TabName = Periode
Case Else
TypMA = "" 'Kein oder Falscher Eintrag für Typ Mitarbeiter
End Select
If TypMA = "" Then
'Eintrag, wenn keine Formel eingetragen wurde wg. fehlendem/falschem Typ-Mitarbeiter
Zelle.Value = "XYZ"
Else
If TabName = Monat Then
'Formeltext erzeugen
Formel = "=IF(ISERROR(DATEVALUE(TEXT('" & Left(Datei, PosLast) _
& "[" & Mid(Datei, PosLast + 1) & "]" & TabName _
& "'!R24C3,""TT.MM.JJJJ""))),"""",""X"")"
ElseIf TabName = Periode Then
'Formeltext erzeugen
Formel = "=IF(ROUND('" & Left(Datei, PosLast) _
& "[" & Mid(Datei, PosLast + 1) & "]" & TabName _
& "'!R40C15,2) -77.00 ,""X"","""")"
End If
'Formel eintragen
Zelle.FormulaR1C1 = Formel
End If
End If
Next
Exit Sub
FehlerCheck:
MsgBox "Tabellenblatt-Name " & TabName & " ist nicht vorhanden in " & vbLf & "Datei " _
& Datei & vbLf & vbLf _
& " oder enthält unzulässige Zeichen wie : ? / * [ ]" & vbLf & vbLf _
& "Makroausführung wird abgebrochen"
End Sub