09. marts 2014 - 10:17
Der 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.
MVH
Petert
Jeg kører Win 7
Office 2010
23. marts 2014 - 11:03
#1
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
findFil = False
End Function
