09. marts 2014 - 10:17Der er
1 kommentar og 1 løsning
Hjælp til Makro.
Hej Jeg søger hjælp til til makro der kan indsætte Hyberlink fra anden mappe. Kort info. jeg har et opmærkningsark over netværks kabler. I en anden mappe har jeg en lang række testresultater for hver kabel forbindelser. Disse testresultater kan både optræde som PDF,HTML,eller begge dele. I Opmærkningsarket har jeg i kolonne J listen med kabel opmærkningen. Eks. P0010210 P0010211 P0010212 P0010213
I en selvstændig mappe (som kun indeholder test resultaterne, til tider 2-300 stk.) har jeg eks. P0010210.pdf P0010211.pdf P0010212.pdf P0010213.pdf og /eller P0010210.html (da disse kan udskrives i disse to formater.) Det jeg ønsker at kunne gøre er følgende. Jeg trykker på en knap i Excel, en dialog box kommer op, jeg vælger hvilken mappe filerne ligger i, og makroen indsætte et hyberlink i kolonne K (hvis pds) eller L (hvis html) i samme række som passer med nummeret i kolonne J. Er der nogle der kan hjælpe mig med dette ? jeg har et ark som viser opgaven meget enkelt, som jeg kan sende.
Dim sti As String 'alternativ - derf. som constant drev/mappe Dim mappeNavn As String Private Sub UserForm_initialize() sti = ActiveWorkbook.Path findMapper sti End Sub Private Sub findMapper(mappesti) Dim fs, f, f1, fc, filNavn As String
Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(mappesti) Set fc = f.subFolders For Each f1 In fc mappeNavn = f1.Name Me.ListBox1.AddItem mappeNavn Next End Sub Private Sub ListBox1_Click() mappeNavn = Me.ListBox1 End Sub Private Sub CommandButton1_Click() Dim ræk As Integer, nr As String For ræk = 2 To ActiveCell.SpecialCells(xlLastCell).Row Range("J" & ræk).Select If Selection <> "" Then Rem test om HL er beregnet If Selection <> "" And Range("K" & ræk) = "" And Range("L" & ræk) = "" Then nr = Selection
If findFil(nr, ".pdf") = True Then Rem opret hyperlink - PDF ActiveSheet.Hyperlinks.Add Anchor:=Range("K" & ræk), Address:= _ mappeNavn & "\" & nr & ".pdf", TextToDisplay:=mappeNavn & "\" & nr & ".pdf" End If
If findFil(nr, ".html") = True Then Rem opret hyperlink - HTML ActiveSheet.Hyperlinks.Add Anchor:=Range("L" & ræk), Address:= _ mappeNavn & "\" & nr & ".html", TextToDisplay:=mappeNavn & "\" & nr & ".html" End If End If Else Exit Sub End If Next ræk End Sub Private Function findFil(nr, suffix) Dim fs, f, f1, fc, filNavn As String
Set fs = CreateObject("Scripting.FileSystemObject") Set fc = fs.GetFolder(sti & "\" & mappeNavn) For Each f1 In fc.Files If InStr(f1.Name, nr & suffix) > 0 Then findFil = True Exit Function End If Next
Tusind tak for hjælpen. Det virker perfekt. MVH Petert
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
