VBA Von Zelle aus Link in andere Spalte
28.07.2022 11:22:39
Raucher
Bin noch totaler VBA-Neuling und versuche ein Projekt zu realisieren.
Ich erstelle gerade eine Personaldatenbank in Excel, in die per Userform Daten eingegeben werden sollen.
Das Ziel ist es, alle Eingaben oder Abfragen nur über die Userform zu ermöglichen, ohne direkten Zugriff auf die Tabelle.
Das habe ich auch soweit schon recht gut hinbekommen.
Mein Problem liegt jetzt bei einem Hyperlink, der zum jeweiligen Personalordner des Mitarbeiters führen soll.
Mit einem Mausklick auf einen Commandbutton soll der Ordner mit Unterordnern erzeugt werden. Dabei setzt sich der Name des
Ordners aus dem Nachnamen, dem Vornamen und der Personalnummer zusammen. Das funktioniert auch, der Ordner und Unterordner werden wie gewünscht erstellt.
Nun möchte ich, das beim erzeugen der Ordner der entsprechende Link ausgehendend von der Zelle in der sich die Personalnummer befindet in der selben Zeile in die
30te Spalte eingetragen wird. Excel erzeugt den Link zwar in der 30ten Spalte aber um 16 Zeilen nach unten versetzt. Also zum Beispiel von Zelle A1 ausgehend in Zelle AD17. Wo liegt mein Fehler? Ich bitte um Hilfe.
Hier ist mein verwendeter Code:
Private Sub CommandButtonORDNERNEU_Click()
'Neue Ordner erzeugen
On Error Resume Next
'Hauptordner anlegen
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text
'Unterordner anlegen
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Arbeitsvertrag, Anstellungsvertrag, Dienstvertrag, Vertragsänderung"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Aus- und Weiterbildungsunterlagen"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Berichte über Arbeitsunfälle"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Bescheinigungen (MuSch, SB, Elternzeit, pers. Schriftwechsel, Kind krank etc.)"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Bewerbung, Lebenslauf, Zeugnisse"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Datenschutzverpflichtungen"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Eingruppierungen, Zulagen"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Entwicklungsplan"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Kündigung, Austrittsdokumente"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Leistungsbewertungen, Beurteilungen"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Sonstiges"
MkDir "C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text & "\ Zwischenzeugnisse"
'Hyperlink erzeugen
Dim finden As Range
Set finden = Columns(1).Find(what:=TextBoxPERSONALNUMMER.Value)
ActiveSheet.Hyperlinks.Add anchor:=finden(ActiveCell.Row, 30), Address:="C:\Users\cgrams\Documents\Digitale Personalakte\" & TextBoxNACHNAME.Text & "_" & TextBoxVORNAME.Text & "_" & TextBoxPERSONALNUMMER.Text, TextToDisplay:="Personalordner"
On Error GoTo 0
End Sub