Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Erweiterung von vorhanden Makro





Frage

Hi liebe community, ich habe hier eine makro (thx an beverly) das ich noch gerne verbessern würde bzw. für meinen verwendungszweck optimieren möchte. und zwar geht es darum das ich die dateinamen gleich mit einer hyperlink verknüpfen möchte kann mir dabei jemand helfen ??? thx im voraus lg martin hier das makro: Sub daten_uebernehmen() Dim Dateien As Integer Dim loZeile As Long Dim strPfad As String loZeile = 2 strPfad = "C:\Test" ' <== Pfad anpassen Application.DisplayAlerts = False With Application.FileSearch .NewSearch .LookIn = strPfad .SearchSubFolders = False .Filename = "*.xls" If .Execute() > 0 Then For Dateien = 1 To .FoundFiles.Count Cells(loZeile, 1) = Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien))) Cells(loZeile, 2).FormulaLocal = "='" & strPfad & "\" & "[" & _ Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien))) & "]Tabelle1'!D2" Cells(loZeile, 3).FormulaLocal = "='" & strPfad & "\" & "[" & _ Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien))) & "]Tabelle1'!H13" Cells(loZeile, 4).FormulaLocal = "='" & strPfad & "\" & "[" & _ Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien))) & "]Tabelle1'!H14" loZeile = loZeile + 1 Next Dateien End If End With Range("B2:D" & IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)).Copy Range("B2").PasteSpecial Paste:=xlValues Application.CutCopyMode = False Application.DisplayAlerts = False End Sub

Antwort 1 von DukeNT

Hi Martin,
tausche deine For...Next schleife gegen diese aus und schon hast du die Dateinamen als Hyperlink mit drin.

For Dateien = 1 To .FoundFiles.Count
Datei = Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien)))
Cells(loZeile, 1) = Datei
Cells(loZeile, 1).Hyperlinks.Add Anchor:=Cells(loZeile, 1), Address:=strPfad & "\" & Datei, TextToDisplay:=Datei
Cells(loZeile, 2).FormulaLocal = "='" & strPfad & "\" & "[" & Datei & "]Tabelle1'!D2"
Cells(loZeile, 3).FormulaLocal = "='" & strPfad & "\" & "[" & Datei & "]Tabelle1'!H13"
Cells(loZeile, 4).FormulaLocal = "='" & strPfad & "\" & "[" & Datei & "]Tabelle1'!H14"
loZeile = loZeile + 1
Next Dateien

Gruß Niels

Antwort 2 von Sp|n.aT

hi Niels

hat wunderbar geklappt deine änderung
großes DANKE an dich und all die anderen freiwilligen helfer
ihr seit einfach große klasse !!!!!!!!!!

grüße aus österreich
martin

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: