Attribute VB_Name = "NewMacros" 
Sub Print_Beatrice_Results() 
Attribute Print_Beatrice_Results.VB_Description = "Macro recorded 2004.11.17. by Nagy Ferenc" 
Attribute Print_Beatrice_Results.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Print_Beatrice_Results" 
' 
' Print_Beatrice_Results Macro 
' Macro recorded 2004.11.17. by Nagy Ferenc 
' 
    Dim dlgOpen As FileDialog, vrtSelectedItem As Variant 
    Dim inidir As String 
    On Error Resume Next 
    inidir = Environ("Beatrice") 
    If inidir = "" Then 
        inidir = "C:\Fortran\Beatrice\Results" 
    End If 
    ChangeFileOpenDirectory inidir 
    On Error GoTo 0 
    Set dlgOpen = Application.FileDialog(msoFileDialogOpen) 
 
    With dlgOpen 
        .AllowMultiSelect = True 
        .Filters.Clear 
 
'Add a filter that includes all files. 
                .Filters.Add "Result files", "*.prn", 1 
                .Filters.Add "Summary files", "*.sum", 2 
                .Filters.Add "Log files", "*.log", 3 
                .Filters.Add "Header files", "*.hdr", 4 
                .Filters.Add "Data files", "*.inp;*.txt", 5 
                .Filters.Add "All files", "*.*", 6 
                .title = "Select one or more Beatrice input/output files" 
                .InitialView = msoFileDialogViewDetails 
                .InitialFileName = inidir & "\*.prn" 
        If .Show = -1Then 
            For Each vrtSelectedItem In .SelectedItems 
 
'vrtSelectedItem is a string that contains the path of each selected item. 
                Documents.Open FileName:=vrtSelectedItem, ConfirmConversions:=False, _ 
                    ReadOnly:=True, AddToRecentFiles:=True, PasswordDocument:="", _ 
                    PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ 
                    WritePasswordTemplate:="", Format:=wdOpenFormatAuto, Encoding:=1250 
                With ActiveDocument.PageSetup 
                    .LineNumbering.Active = False 
                    .Orientation = wdOrientLandscape 
                    .TopMargin = CentimetersToPoints(2.03) 
                    .BottomMargin = CentimetersToPoints(2.03) 
                    .LeftMargin = CentimetersToPoints(2) 
                    .RightMargin = CentimetersToPoints(2) 
                    .Gutter = CentimetersToPoints(0) 
                    .HeaderDistance = CentimetersToPoints(1.25) 
                    .FooterDistance = CentimetersToPoints(1.25) 
                    .PageWidth = CentimetersToPoints(29.7) 
                    .PageHeight = CentimetersToPoints(21) 
                    .FirstPageTray = wdPrinterDefaultBin 
                    .OtherPagesTray = wdPrinterDefaultBin 
                    .SectionStart = wdSectionNewPage 
                    .OddAndEvenPagesHeaderFooter = False 
                    .DifferentFirstPageHeaderFooter = True 
                    .VerticalAlignment = wdAlignVerticalTop 
                    .SuppressEndnotes = False 
                    .MirrorMargins = False 
                    .TwoPagesOnOne = False 
                    .BookFoldPrinting = False 
                    .BookFoldRevPrinting = False 
                    .BookFoldPrintingSheets = 1 
                    .GutterPos = wdGutterPosLeft 
                    .SectionDirection = wdSectionDirectionLtr 
                End With 
                Selection.WholeStory 
Page_Num 
                If Application.PrintPreview = False Then 
                    ActiveDocument.PrintPreview 
                End If 
            Next vrtSelectedItem 
            SendKeys "%fp" 
        End If 
    End With 
 
End Sub 
Sub Page_Num() 
Attribute Page_Num.VB_Description = "Macro recorded 2004.11.17. by Nagy Ferenc" 
Attribute Page_Num.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1" 
' 
' Page_Num Macro 
' Macro recorded 2004.11.17. by Nagy Ferenc 
' 
' Page numbering: 
' path and file name on the header of the first page, 
'  -- # -- in the footer from the second page 
    With ActiveDocument.PageSetup 
                .OddAndEvenPagesHeaderFooter = False 
                .DifferentFirstPageHeaderFooter = True 
    End With 
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2" 
    ActiveWindow.ActivePane.View.Type = wdOutlineView 
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter 
    Selection.InsertSymbol CharacterNumber:=8212, Unicode:=True, Bias:=0 
    Selection.TypeText Text:="" 
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage 
    Selection.TypeText Text:="" 
    Selection.InsertSymbol CharacterNumber:=8212, Unicode:=True, Bias:=0 
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1" 
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _ 
"FILENAME  \p", PreserveFormatting:=True 
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1" 
    Selection.Text = "" 
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 
End Sub 
Sub Bmr2Pic() 
Attribute Bmr2Pic.VB_Description = "Macro recorded 2005.09.02. by Nagy Ferenc\r\nJobbra igazított bitképeket jelentő ""{bmr"" parancsok keresése és rendes képbeillesztéssé alakítása. " 
Attribute Bmr2Pic.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Bmr2Pic" 
' 
' Bmr2Pic Macro 
' Macro recorded 2005.09.02. by Nagy Ferenc 
' Jobbra igazított bitképeket jelentő "{bmr"  parancsok keresése és rendes képbeillesztéssé alakítása. 
Dim selected_folder As String 
    Dim selected_file As String 
    Dim selected_full As String 
    Find_Bmx_Field "[{]bmr *bmp[}]", selected_folder, selected_file, selected_full 
    If selected_folder <>""Then 
        If selected_folder = "."Then 
                        selected_full = selected_file 
Else 
                        selected_full = selected_folder & "\" & selected_file 
        End If 
         With ActiveDocument.Shapes(ActiveDocument.Shapes.Count) 
            .WrapFormat.Type = wdWrapTopBottom 
            .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin 
            .RelativeVerticalPosition = wdRelativeVerticalPositionLine 
            .Left = wdShapeRight 
            .Top = wdShapeTop 
            .LockAnchor = False 
        End With 
    End If 
End Sub 
Sub Bml2Pic() 
' 
' BmrlPic Macro 
' Macro recorded 2005.09.02. by Nagy Ferenc 
' Balra igazított bitképeket jelentő "{bml" parancsok keresése és rendes képbeillesztéssé alakítása. 
' 
    Dim selected_folder As String 
    Dim selected_file As String 
    Dim selected_full As String 
    Find_Bmx_Field "[{]bml *bmp[}]", selected_folder, selected_file, selected_full 
    If selected_folder <>""Then 
        If selected_folder = "."Then 
            selected_full = selected_file 
Else 
            selected_full = selected_folder & "\"  & selected_file 
        End If 
 
        ActiveDocument.Shapes.AddPicture selected_full, True, False, , , , , Selection.Range 
        With ActiveDocument.Shapes(ActiveDocument.Shapes.Count) 
                        .WrapFormat.Type = wdWrapTopBottom 
                        .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin 
                        .RelativeVerticalPosition = wdRelativeVerticalPositionLine 
                        .Left = wdShapeLeft 
                        .Top = wdShapeTop 
                        .LockAnchor = False 
        End With 
    End If 
 
 End Sub 
Function Select_Folder(title As  String) As String 
    Const FileDialogType = msoFileDialogFolderPicker 
'Declare a variable as a FileDialog object. 
    Dim fd As FileDialog 
    Dim vrtSelectedItem As Variant 
'Create a FileDialog object as   a File Picker dialog box. 
    Set fd = Application.FileDialog(FileDialogType) 
 
'Declare a variable to contain the path 
'of each selected item. Even though the path is a String, 
'the variable must be a Variant because For Each...Next 
'routines only work with Variants and Objects. 
 
'Use a With...End With block to reference the FileDialog object. 
    With fd 
        .AllowMultiSelect = False 
        .InitialFileName = Environ("Beatrice") & "\Manual\Images" 
        .InitialView = msoFileDialogViewThumbnail 
        .title = title 
'Use the Show method to display the File Picker dialog box and return the user's action. 
'The user pressed the action button. 
        If .Show = -1Then 
            If .SelectedItems.Count = 1Then 
                Select_Folder = .SelectedItems(1) 
Else 
                Select_Folder = "" 
            End If 
'The user pressed Cancel. 
Else 
            Select_Folder = "" 
        End If 
    End With 
 
'Set the object variable to Nothing. 
    Set fd = Nothing 
 
End Function 
 
Sub Bmc2pic() 
Attribute Bmc2pic.VB_Description = "Macro recorded 2005.09.02. by Nagy Ferenc\r\nKarakterként a szövegbe illesztett kép " 
Attribute Bmc2pic.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.bmc2pic" 
' 
' Bmc2pic Macro 
' Macro recorded 2005.09.02. by Nagy Ferenc 
' Karakterként a szövegbe illesztett bitképeket jelentő "{bmc"  parancsok keresése és rendes képbeillesztéssé alakítása. 
' 
    Dim selected_folder As String 
    Dim selected_file As String 
    Dim selected_full As String 
    Find_Bmx_Field "[{]bmc *bmp[}]", selected_folder, selected_file, selected_full 
    If selected_folder <> "" Then 
        If selected_folder = "." Then 
            selected_full = selected_file 
Else 
            selected_full = Replace(selected_folder & "\" & selected_file, "\", "\\", vbTextCompare) 
        End If 
        Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _ 
        Text:="INCLUDEPICTURE  " & Chr(34) & selected_full & Chr(34) & " \d ", _ 
        PreserveFormatting:=False 
    End If 
 
    Selection.TypeText text_after 
End Sub 
Sub Find_Bmx_Field(wildcard As String, selected_folder As String, selected_file As String, selected_full As String) 
' Find bitmap field given by wildcard in preliminary RTF files of help authoring and give back file name within the field 
' Wildcard string should be "[{]bmc *bmp[}]" or "[{]bml *bmp[}]" or "[{]bmr *bmp[}]" 
    Dim p As Integer 
    With Selection.Find 
        .ClearFormatting 
        .Text = wildcard 
        .Replacement.Text = "" 
        .Forward = True 
        .Wrap = wdFindContinue 
        .Format = False 
        .MatchCase = False 
        .MatchWholeWord = False 
        .MatchKashida = False 
        .MatchDiacritics = False 
        .MatchAlefHamza = False 
        .MatchControl = False 
        .MatchAllWordForms = False 
        .MatchSoundsLike = False 
        .MatchWildcards = True 
        .Execute 
    End With 
    p = InStr(wildcard, Space(1)) 
    selected_file = Trim(Mid(Selection.Text, p)) 
    selected_file = Left(selected_file, InStrRev(selected_file, "}") - 1) 
    selected_file = Trim(selected_file) 
    selected_folder = Select_Folder("Select the image folder") 
    If selected_folder <> "" Then 
        If ActiveDocument.Path = selected_folder Then 
            selected_folder = "." 
        ElseIf InStr(ActiveDocument.Path, selected_folder) = 1 Then 
            selected_folder = Mid(selected_folder, Len(ActiveDocument.Path) + 1) 
        End If 
    End If 
 
End Sub 
 
Sub Help_Superscript() 
' 
' Help_Superscript Makró 
' Rögzítés: 2006.02.21., készítő: Dr Nagy Ferenc 
' "&chr(10)&"Bookman Old Style --> Arial Superscript 
' 
    With Selection.Find 
                .Font.Name = "Bookman Old Style" 
                .Text = "" 
                .Replacement.Text = "" 
                .Replacement.Font.Name = "Arial" 
                .Replacement.Font.Superscript = True 
                .Forward = True 
                .Wrap = wdFindContinue 
                .Format = True 
                .MatchCase = False 
                .MatchWholeWord = False 
                .MatchWildcards = False 
                .MatchSoundsLike = False 
                .MatchAllWordForms = False 
                .Execute Replace:=wdReplaceAll 
    End With 
End Sub 
 
Sub Help_Subscript() 
Attribute Help_Subscript.VB_Description = "Rögzítés: 2006.02.21., készítő: Dr Nagy Ferenc\r\nBook Antiqua --> Arial Subscript " 
Attribute Help_Subscript.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Help_Subscript" 
' 
' Help_Subscript Makró 
' Rögzítés: 2006.02.21., készítő: Dr Nagy Ferenc 
'"&chr(10)&"Book Antiqua --> Arial Subscript 
' 
    With Selection.Find 
        .Font.Name = "Book Antiqua" 
        .Text = "" 
        .Replacement.Text = "" 
        .Replacement.Font.Name = "Arial" 
        .Replacement.Font.Subscript = True 
        .Forward = True 
        .Wrap = wdFindContinue 
        .Format = True 
        .MatchCase = False 
        .MatchWholeWord = False 
        .MatchWildcards = False 
        .MatchSoundsLike = False 
        .MatchAllWordForms = False 
        .Execute Replace:=wdReplaceAll 
    End With 
End Sub 
 
Sub Help_LInk() 
' 
' Help_Link Makró 
' Rögzítés: 2006.02.21., készítő: Dr Nagy Ferenc 
' "&chr(10)&"Times New Roman --> Times New Roman, Underlined, Blue 
' 
    With Selection.Find 
                .Font.Name = "Times New Roman" 
                .Text = "" 
                .Replacement.Text = "" 
                .Replacement.Font.Color = wdColorBlue 
                .Replacement.Font.Underline = wdUnderlineSingle 
                .Forward = True 
                .Wrap = wdFindContinue 
                .Format = True 
                .MatchCase = False 
                .MatchWholeWord = False 
                .MatchWildcards = False 
                .MatchSoundsLike = False 
                .MatchAllWordForms = False 
                .Execute Replace:=wdReplaceAll 
    End With 
End Sub 
 
Sub Egyenletszerkesztő() 
Attribute Egyenletszerkesztő.VB_Description = "Rögzítés: 2006. március 25., készítő: Dr Nagy Ferenc " 
Attribute Egyenletszerkesztő.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Egyenletszerkesztő" 
' 
' Egyenletszerkesztő Makró 
' Rögzítés: 2006. március 25., készítő: Dr Nagy Ferenc 
' 
    Selection.InlineShapes.AddOLEObject ClassType:="Equation.3", FileName:="", _ 
         LinkToFile:=False, DisplayAsIcon:=False 
End Sub