Hyperlink Ordner anprechen
28.05.2020 09:21:01
Angelika
Durch einen CommandButton werden div. Abläufe gestartet.
In der Zelle in der ich mich befinde wird ein Nummernkreis generiert.
Xxxx_xx_xxxx 4 stellige fortlaufende Nummer-Auswahlfeld-Datum
Diese neu erstellt Nummer wird als Ordner im
Verzeichnis : //srvfs01/Daten/Einkauf/Anfragen/Anfragen" gespeichert.
und die Nummer mit Hyperlink hinterlegt.
0087-SP-28-05-2020
0079-RD-13-05-2020
0013-PM-25-04-2020
Wenn ich nun irgendeine Nummer aus meiner Liste anklicke : z.b. 0079-RD-13-05-2020
Spring der Cursor auf den Ordner Anfragen.
NUN meine Frage: wie kann ich meinen Code abändern, dass er mir auf den Ordner 0079-RD-13-05-2020 springt
Option Explicit
Private Sub CommandButton1_Click()
Dim sTxt As String
Dim Sp%, LR%
Dim iNr As Integer, i As Integer
Dim sAA As String, svAA As String, stAA As String
svAA = ",SP,SCM,SA,PM,PR,QS,RD,TE,"
stAA = "1=SP 2=SCM 30=SA 4=PM 5=PR 6=QS 7=RD 8=TE"
'zur Sicherheit, damit man in der richtigen Zelle ist
If MsgBox("Sind sie in der richtigen Zelle ?", vbYesNo) = vbNo Then
Exit Sub
Else
With ActiveCell
If .Column = 2 And .Row > 13 Then
Nochmal:
sAA = InputBox("Bitte die Anforderungsabteilung oder Nr eingeben!" & vbCr & stAA, " _
Anforderungsabteilung", "SP")
If StrPtr(sAA) = 0 Then Exit Sub
sAA = UCase$(sAA)
If Val(sAA) > 0 Then
sAA = Split(svAA, ",")(Val(sAA))
ElseIf InStr(svAA, "," & sAA & ",") = 0 Then
GoTo Nochmal
End If
For i = .Row - 1 To 13 Step -1
If Cells(i, .Column).Value "" Then Exit For
Next
iNr = Val(Left$(Cells(i, .Column).Value & " ", 4)) + 1
.Value = Right$("0000" & CStr(iNr), 4) & "-" & sAA & Format(Date, "-dd-mm-yyyy")
' MkDir ("//srvfs01/Daten/Einkauf/Anfragen/Anfragen/" & .Value)
MkDir ("//srvfs01/Daten/Einkauf/TestAHG/" & .Value)
End If
End With
' setzt in der Zelle welche generiert wurde den Hyperlink
ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:="//srvfs01/Daten/Einkauf/Anfragen/ _
Anfragen"
Range("B14").Select
Rows("14:14").EntireRow.AutoFit
Columns("B:B").ColumnWidth = 20
Range("B14").Select
' springt zur nächsten leeren Zelle
Sp = 2
LR = Cells(Rows.Count, Sp).End(xlUp).Row
Cells(LR + 1, Sp).Select
End If
End Sub
Für Eure Hilfe wäre ich dankbar Angelika