Hollosi Information eXchange /HIX/
HIX GURU 6997
Copyright (C) HIX
2018-04-25
Új cikk beküldése (a cikk tartalma az író felelőssége)
Megrendelés Lemondás
1 re: .docx kereses egyszeruen-hogyan? (mind)  95 sor     (cikkei)

+ - re: .docx kereses egyszeruen-hogyan? (mind) VÁLASZ  Feladó: (cikkei)

Küldök két word makrót. Remélem ilyesmire gondoltál. (Office 2007 alatt 
teszteltem, remélem nem lesz gond az újabb wordben sem.)
Az elsőt egy üres dokumentumból kell indítani. Bekéri a könyvtárat, 
amiből dolgozzon. Az abban levő .docx-eket megnyitva megkeresi a 
hyperlinkeket, majd azokat az üres dokumentumba másolja szövegként. A 
kapott eredmény formája:

http://valami1.cim
http://valahol.cim
http://valami.cim
.docx neve
http://masvalami.cim
másik .docx neve
stb.

Az alkönyvtárakat nem nézi meg, a sima szövegként levő címekkel nem 
foglalkozik, csak a hiperhivatkozásokkal.

A másodikat egy megnyitott doc-ból kell indítani. Az ebben a doc-ban 
levő hiperhivatkozásokat keresi meg, és rakja egy üres dokumentumba.



Sub web_hivatkozas_konyvtarbol()

     Dim oLink As Hyperlink
     Dim docCurrent As Document
     Dim doc_keres As Document
     Dim rngStory As StoryRanges
     Set docCurrent = ActiveDocument
Dim SrcFldr As String
MsgBox "Válaszd ki a forrás mappát!"
With Application.FileDialog(msoFileDialogFolderPicker)
     .AllowMultiSelect = False
     .Show
SrcFldr = .SelectedItems(1)
End With
Application.ScreenUpdating = False
  n$ = Dir(SrcFldr & "\" & "*.docx")
If n$ <> "" Then
On Error GoTo hiba
While n$ <> ""
Selection.InsertBefore Text:=(n$ + Chr(13))
Documents.Open SrcFldr & "\" & n$
  Windows(n$).Activate
  Set doc_keres = ActiveDocument
     For Each oLink In doc_keres.Hyperlinks
         Set rng = docCurrent.Range
         rng.Collapse
         rng.InsertAfter (oLink.Address) + Chr(13)
      Next
     doc_keres.Close (wdDoNotSaveChanges)
      docCurrent.Activate
n$ = Dir()
Wend
     Else
         Application.ScreenUpdating = True
         MsgBox ("A könyvtár nem tartalmaz .docx fájlt")
         Set doc_keres = Nothing
         Set docCurrent = Nothing
         Exit Sub
End If
Application.ScreenUpdating = True
     Set doc_keres = Nothing
     Set docCurrent = Nothing
     Exit Sub
hiba:
Application.ScreenUpdating = True
MsgBox ("Valami hiba történt!")
a = Err.Number
Stop

End Sub



Sub web_hivatkozas_docbol()
     Dim docCurrent As Document
     Dim docNew As Document
     Dim oLink As Hyperlink
     Dim rng As Range
     Application.ScreenUpdating = False
     Set docCurrent = ActiveDocument
     Set docNew = Documents.Add
     For Each oLink In docCurrent.Hyperlinks
         Set rng = docNew.Range
         rng.Collapse
'        rng.InsertAfter (oLink.TextToDisplay) + Chr(9) + 
(oLink.Address) + Chr(13)
         rng.InsertAfter (oLink.Address) + Chr(13)
     Next
     docNew.Activate
     Application.ScreenUpdating = True
     Application.ScreenRefresh
End Sub

AGYKONTROLL ALLAT AUTO AZSIA BUDAPEST CODER DOSZ FELVIDEK FILM FILOZOFIA FORUM GURU HANG HIPHOP HIRDETES HIRMONDO HIXDVD HUDOM HUNGARY JATEK KEP KONYHA KONYV KORNYESZ KUKKER KULTURA LINUX MAGELLAN MAHAL MOBIL MOKA MOZAIK NARANCS NARANCS1 NY NYELV OTTHON OTTHONKA PARA RANDI REJTVENY SCM SPORT SZABAD SZALON TANC TIPP TUDOMANY UK UTAZAS UTLEVEL VITA WEBMESTER WINDOWS