Kategorie szkoleń | Egzaminy | Kontakt
  • 1
  • 2
  • 261

Usiłuję "sklecić" makro, które, gdy kliknie się dwukrotnie na wyraz, spowoduje stworzenie linku do dokumentu i dokumentu ze wszystkimi makrami o nazwie takiej, jak kliknięty wyraz. 

Oto jego treść:

Dim objClass As New clsWordAppSub Register_EventHandler()    Set objClass.appWord = Word.ApplicationEnd SubSub test()'expand selection to whole word    Selection.Expand Unit:=wdWord    If Selection.Characters.Last = " " Then    Selection.End = Selection.End - 1    End If    Selection.Font.Underline = wdUnderlineSingle    'send selection to variable    Dim selBkUp As Range    Set selBkUp = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End)    'check if file exists    Dim fso As Object    Dim objWord As Word.Application    Dim doc As Word.Document        Set fso = CreateObject("Scripting.FileSystemObject")    Set objWord = CreateObject("Word.Application")             If fso.FileExists(ActiveDocument.Path & "/" & selBkUp & ".docm") Then     MsgBox "File exists "    Documents.Open (ActiveDocument.Path & "/" & selBkUp & ".docm")         Else     MsgBox "No such file "    Documents.Add(ActiveDocument.Path & "/" & "Test_template.dotm").SaveAs (ActiveDocument.Path & "/" & selBkUp & ".docm")    Kill ActiveDocument.Path & "/" & "Test_template.dotm"            End If            End SubSub CreateDocument()Set doc = CreateObject("Word.Application")doc.Visible = Truedoc.Documents.Open filename:=("Fileaddress")End Sub'http://stackoverflow.com/questions/16244563/vba-check-if-the-file-exists-using-dir-failes-in-windows-7-in-aliased-directoPublic Function FileExists(filename As String) As Boolean    Dim fso As Object    Set fso = CreateObject("Scripting.FileSystemObject")    If fso.FileExists(filename) Then FileExists = True Else FileExists = False    MsgBox "File exists " & selBkUp & ".docx" & FileExists, vbInformation    End Function.

Niestety makro posiada błąd (pewnie jest ich więcej), którego nie mogę zlokalizować. Tworzy on pliki z rozszerzeniem xlsm, które zaraz po utworzeniu można edytować. Jednak powtórne ich otwarcie nie jest możliwe, MSWord nie może ich odczytać (komunikat Runtime error 6296 Rozszerzenie nie jest kompatybilne z zawartością pliku).  Już na wstępie edycji w takim dokumencie pojawia się komunikat, że dokument i jego rozszerzenie nie są kompatybilne. Zastanawiam się, czy nie jest to związane z włączonym compatibility mode.

Co może być przyczyną tworzenia plików, których później nie można otworzyć?

Załączam plik z makrem.

Z góry dziękuję za wszelkie uwagi.

Załączniki

  • zip

    word_wiki.zip ( 46K )
Jacek_Kotowski
  • Zapytał
  • @ Jacek_Kotowski | 06.08.2014
    • lider
    • laureat
    • ekspert
    • 60
    • 54
    • 94

Odpowiedź (1)

  • 9

Powodów może być dużo, łącznie z uprawnieniami, czy niezgodnością typu z rozszerzeniem.

Napisałem kod, który chyba rozwiązuje opisany problem:

 

Sub UtworzKopiePliku_i_Link()
    Dim MojDokument As Word.Document
    Dim Kopia As Word.Document
    Dim ZaznTekst As String
    Dim SciezkaMojDokument As String
    Dim SciezkaFolder As String
    
    ZaznTekst = fnCzystyTekst(Selection.Range.Text)
    If Len(ZaznTekst) = 0 Then
        MsgBox "Brak zaznaczenia!"
        Exit Sub
    End If
    Set MojDokument = ThisDocument
    SciezkaMojDokument = MojDokument.FullName
    SciezkaFolder = MojDokument.Path & "\"
    MojDokument.Bookmarks.Add ZaznTekst, Selection
    MojDokument.Save
    MojDokument.SaveAs SciezkaFolder & ZaznTekst & ".docm"
    Set Kopia = MojDokument
    Set MojDokument = Documents.Open(SciezkaMojDokument)
    Selection.GoTo What:=wdGoToBookmark, Name:=ZaznTekst
    MojDokument.Hyperlinks.Add Anchor:=Selection.Range, _
        Address:=Kopia.Name, TextToDisplay:=ZaznTekst

    Set MojDokument = Nothing
    Kopia.Close
    Set Kopia = Nothing
End Sub

Function fnCzystyTekst(Tekst As String)
    Dim Znak As String * 1, NrZnaku As Long
    For NrZnaku = 1 To Len(Tekst)
        Znak = Mid(Tekst, NrZnaku, 1)
        If Znak Like "[A-Z,a-z,0-9,Ć,Ę,Ł,Ó,Ś,Ż,Ź,ć,ę,ł,ó,ś,ż,ź]" Then
            fnCzystyTekst = fnCzystyTekst & Znak
        End If
    Next
End Function
  • Odpowiedział
  • @ | 02.09.2014
  • TRENER ALTKOM AKADEMII