Office: VBA: Linkgenerierung aus UserForm

Hallo Forum,

ich habe momentan das folgende Problem:
Ich habe eine Excel-Tabelle mit UserForm gebastelt (Anhang) und versuche nun eine Spalte mit Links zu ermöglichen (Also ich meine einen Link, den man in der Excel-Tabelle anklicken kann).
In dem Feld ganz unten "Bericht" in der UserForm soll ein Dateiname eingegeben werden (z.B. "Reagenzglas im Restmüll.pdf"). Jetzt soll das ganze als Hyperlink in Excel gespeichert werden, allerdings setzt sich der Pfad aus gewissen Parametern aus der Eingabe zusammen.
Ich versuch das mal (hoffentlich verständlich) darzustellen:
Der Anfangspfad lautet immer: "S:\Managementsystem-documents\..."
Dann folgt ein Ordner mit dem Jahr (z.B. 2012) -Diese Info soll er sich aus der txtDatum Eingabe ziehen.
Der nächste Ordner heißt entweder "Infos von anderen Standorten", wenn die Checkbox "Eigener Standort?" nicht aktiviert ist oder er heißt (wenn "Eigener Standort" aktiviert) wie die Kategorie aus cboKategorie.

Ich bin hier total am verzweifeln, wie ich das genau machen soll und hoffe, mir kann hiewr jemand helfen...

Beste Grüße
Mad<!-- contentDetection end --> <STYLE type=text/css><!--td.attachrow { font: normal 11px Verdana, Arial, Helvetica, sans-serif; color : #000000; border-color : #000000; }td.attachheader { font: normal 11px Verdana, Arial, Helvetica, sans-serif; color : #000000; border-color : #000000; background-color: #D1D7DC; }table.attachtable { font: normal 12px Verdana, Arial, Helvetica, sans-serif; color : #000000; border-color : #000000; border-collapse : collapse; }--></STYLE>

 

Schnapp Dir mal die Routine "Private Sub cmdOK_Click()" im Code des User-Formulars und passe folgendes an:

a) einige neue Variablen deklarieren (direkt hinter die beiden schon existierenden DIM Zeilen):

Code:

    Dim DocPath1 As String
    Dim DocPath2 As String
    Dim DocPath3 As String
    Dim DocPath4 As String
    Dim DocPath As String

Man kommt mit weniger Variablen aus, aber für die Übersichtlichkeit hab ich's mal etwas aufgeteilt.

b) Den Pfad zum Dokument zusammenbasteln (direkt vor die Zeile mit dem "RowCount = ..."):

Code:

    DocPath1 = "S:\Managementsystem-documents\..."
    DocPath2 = Format$(Year(DateValue(Me.txtDatum.Value)), "0000")
    If (chkEigenerStandort.Value = True) Then
        DocPath3 = "Infos von anderen Standorten"
    Else
        DocPath3 = cboKategorie.Value
    End If
    DocPath4 = txtBericht.Value
    DocPath = DocPath1 & "\" & DocPath2 & "\" & DocPath3 & "\" & DocPath4
    MsgBox DocPath

Die MsgBox kannst Du später, wenn's funktioniert, dann ja wieder deaktivieren.

c) Den Pfad dann als Hyperlink auf die Zelle setzen (direkt hinter die Zeile mit ".Offset(RowCount, 10).Value = ..."):

Code:

        Worksheets("Sheet1").Hyperlinks.Add .Offset(RowCount, 10), DocPath

Das ganze sieht dann so aus:

Code:

Private Sub cmdOK_Click()

    Dim RowCount As Long
    Dim ctl As Control
    Dim DocPath1 As String
    Dim DocPath2 As String
    Dim DocPath3 As String
    Dim DocPath4 As String
    Dim DocPath As String

    If Me.txtBezeichnung.Value = "" Then
        MsgBox "Bitte eine Bezeichnung eingeben.", vbExclamation, "Unfall-Übersicht"
        Me.txtBezeichnung.SetFocus
        Exit Sub
    End If
    If Me.txtDatum.Value = "" Then
        MsgBox "Bitte ein Datum eingeben.", vbExclamation, "Unfall-Übersicht"
        Me.txtDatum.SetFocus
        Exit Sub
    End If
    If Not IsDate(Me.txtDatum.Value) Then
        MsgBox "Das Feld muss ein gültiges Datum enthalten.", vbExclamation, "Unfall-Übersicht"
        Me.txtDatum.SetFocus
        Exit Sub
    End If
    If Me.cboKategorie.Value = "" Then
        MsgBox "Bitte eine Kategorie auswählen.", vbExclamation, "Unfall-Übersicht"
        Me.cboKategorie.SetFocus
        Exit Sub
    End If

    DocPath1 = "S:\Managementsystem-documents\..."
    DocPath2 = Format$(Year(DateValue(Me.txtDatum.Value)), "0000")
    If (chkEigenerStandort.Value = True) Then
        DocPath3 = "Infos von anderen Standorten"
    Else
        DocPath3 = cboKategorie.Value
    End If
    DocPath4 = txtBericht.Value
    DocPath = DocPath1 & "\" & DocPath2 & "\" & DocPath3 & "\" & DocPath4
    MsgBox DocPath

    RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
    With Worksheets("Sheet1").Range("A1")
        .Offset(RowCount, 0).Value = Me.txtBezeichnung.Value
        .Offset(RowCount, 1).Value = DateValue(Me.txtDatum.Value)
        If Me.chkMitarbeiterFremdfirma.Value = True Then
            .Offset(RowCount, 2).Value = "Yes"
        Else
            .Offset(RowCount, 2).Value = "No"
        End If
        .Offset(RowCount, 3).Value = Me.txtWer.Value
        If Me.chkEigenerStandort.Value = True Then
            .Offset(RowCount, 4).Value = "Yes"
        Else
            .Offset(RowCount, 4).Value = "No"
        End If
        .Offset(RowCount, 5).Value = Me.cboWo.Value
        .Offset(RowCount, 6).Value = Me.cboKategorie.Value
        .Offset(RowCount, 7).Value = Me.txtWas.Value
        .Offset(RowCount, 8).Value = Me.txtWieWarum.Value
        .Offset(RowCount, 9).Value = Me.txtMaßnahmen.Value
        .Offset(RowCount, 10).Value = Me.txtBericht.Value
        Worksheets("Sheet1").Hyperlinks.Add .Offset(RowCount, 10), DocPath
        .Offset(RowCount, 11).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
    End With

    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
            ctl.Value = ""
        ElseIf TypeName(ctl) = "CheckBox" Then
            ctl.Value = False
        End If
    Next ctl

End Sub

Dann probier's mal aus...

Gruß, Michael