1

Тема: Крякозябры в формах создаваемых кодом

Скачал код программы каталогизации, где форма создается в самом коде.
При запуске - вопросы вместо русских букв, относящихся к тексту.
Версия Word 2003 ENG, настройка в локали - русская.
Что удивительно - в ListBox все названия выводятся на нормальном русском... - см картинку...
В чем м.б. дело и как устранить не ковыряясь в реестре???

Sub Librarian()
    Dim w1
    Dim w2
    Dim tir
    Dim tir2
    Dim False_
    Dim rash$
    Dim kartinki
    Dim abzac
    
    'TextEncoding = msoEncodingCyrillicAutoDetect
    'Application.Options.DefaultTextEncoding = msoEncodingCyrillic
    
    ReDim ListBox2__$(1)
    ListBox2__$(0) = "По возрастанию"
    ListBox2__$(1) = "По убыванию"
    ReDim ListBox1__$(4)
    ListBox1__$(0) = "Не сортировать"
    ListBox1__$(1) = "По имени"
    ListBox1__$(2) = "По типу"
    ListBox1__$(3) = "По дате"
    ListBox1__$(4) = "По размеру"
    ReDim ListBox3__$(5)
    ListBox3__$(0) = "Не вставлять"
    ListBox3__$(1) = "1"
    ListBox3__$(2) = "2"
    ListBox3__$(3) = "3"
    ListBox3__$(4) = "4"
    ListBox3__$(5) = "5"
    nalkar = 0
    'CodePage
    MyDialog$ = CStr("Каталогизатор")
    WordBasic.BeginDialog 1000, 430, MyDialog$
    WordBasic.PushButton 30, 345, 280, 20, "В текущей директории", "Push1"
    WordBasic.Text 320, 6, 379, 13, "Вас приветствует макрокоманда Каталогизатор."
    WordBasic.Text 40, 26, 950, 13, "Цель этой макрокоманды - помочь Вам разобраться в Ваших файлах или немного облегчить Вам работу при создании Web-сайта."
    WordBasic.Text 20, 46, 970, 13, "Макрокоманда создает в активном документе список из гиперссылок на все файлы в какой - либо директории (текущей или задаваемой "
    WordBasic.Text 20, 66, 970, 13, "пользователем), к которым можно приписать пояснения о содержимом файлов или просто вставить эти ссылки в свой документ. Можно "
    WordBasic.Text 20, 86, 970, 13, "настроить вид сортировки гиперссылок - по имени файлов, расширению их и др., а также определить, будут ли гиперссылки содержать "
    WordBasic.Text 20, 106, 970, 13, "полные пути к файлам или только ссылки на их имена (в последнем случае переход по ссылкам будет возможен лишь в том случае, если "
    WordBasic.Text 20, 126, 970, 13, "документ с гиперссылками находится в том же каталоге, что и файлы). Скрытые файлы в каталог не включаются."
    WordBasic.Text 250, 148, 570, 13, "Пожалуйста, установите нужные опции и нажмите одну из кнопок внизу."
    WordBasic.OptionGroup "OptionGroup1"
    WordBasic.OptionButton 20, 170, 670, 16, " Указывать в гиперссылках полный путь к файлам (хорошо при каталогизации файлов)", "OptionButton1"
    WordBasic.OptionButton 20, 190, 610, 16, " Указывать в гиперссылках только имена файлов (хорошо при разработке сайта)", "OptionButton2"
    WordBasic.CheckBox 80, 217, 450, 13, "Отметьте здесь, чтобы после каждой ссылки на картинку", "CheckBox1"
    WordBasic.Text 55, 237, 500, 13, "(файл с окончанием .gif или .jpeg(.jpg)) вставлялась сама эта картинка."
    WordBasic.CheckBox 80, 257, 450, 13, "Не сохранять вставляемые рисунки вместе с документом", "CheckBox2"
    WordBasic.Text 740, 175, 200, 13, "Сортировать файлы:"
    WordBasic.ListBox 670, 195, 140, 69, ListBox1__$(), "ListBox1"
    WordBasic.ListBox 835, 215, 142, 33, ListBox2__$(), "ListBox2"
    WordBasic.Text 630, 270, 350, 16, "Укажите здесь, сколько символов конца абзаца"
    WordBasic.Text 670, 290, 300, 16, "вставлять после каждой гиперссылки:"
    WordBasic.ListBox 750, 310, 125, 33, ListBox3__$(), "ListBox3"
    WordBasic.TextBox 50, 290, 45, 18, "TextBox1"
    WordBasic.Text 120, 282, 500, 13, "Если вы желаете каталогизировать файлы только одного типа, "
    WordBasic.Text 120, 305, 500, 13, "то укажите в этом окне расширение для этого типа файлов."
    WordBasic.Text 210, 325, 318, 13, "Создать каталог файлов, находящихся:"
    WordBasic.PushButton 370, 345, 280, 20, "В выбранной директории", "Push2"
    WordBasic.Text 22, 370, 300, 13, "Будет создан каталог файлов директории,"
    WordBasic.Text 45, 387, 300, 13, " где находится текущий документ."
    WordBasic.Text 370, 370, 480, 13, "Укажите директорию в диалоговом окне"
    WordBasic.Text 360, 387, 480, 13, "(не обращайте внимание на заголовок окна!)"
    WordBasic.CancelButton 715, 365, 88, 21
    WordBasic.Text 840, 355, 150, 13, "Автор программы -"
    WordBasic.Text 850, 370, 140, 13, "Орлов Антон"
    WordBasic.Text 840, 385, 150, 13, "Александрович,"
    WordBasic.Text 160, 410, 745, 13, "(Ярлыки также подвергаются каталогизации, но гиперссылки указывают на объекты ярлыков!)"
    WordBasic.Text 865, 400, 100, 13, "1999 г."
    WordBasic.EndDialog
    Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog
    dlg.CheckBox1 = False_
    dlg.ListBox2 = 0
    dlg.ListBox1 = 0
    dlg.listBox3 = 0
    dlg.CheckBox2 = 1
    On Error GoTo -1: On Error GoTo bye
    WordBasic.Dialog.UserDialog dlg
    rash$ = dlg.TextBox1
    kartinki = dlg.CheckBox1
    abzac = dlg.listBox3
    If dlg.OptionGroup1 = 1 Then w2 = 1 Else w2 = 0
    If dlg.Push1 = True_ Then w1 = 0
    If dlg.Push2 = True_ Then w1 = 1
    tir = dlg.ListBox1
    tir2 = dlg.ListBox2
    l1 = True
    l2 = False
    If dlg.CheckBox2 = 0 Then
        l1 = False
        l2 = True
    End If
    Select Case tir
    Case 1
        sortir = msoSortByFileName
    Case 2
        sortir = msoSortByFileType
    Case 3
        sortir = msoSortByLastModified
    Case 4
        sortir = msoSortBySize
    End Select
    Select Case tir2
    Case 0
        sortir2 = msoSortOrderAscending
    Case 1
        sortir2 = msoSortOrderDescending
    End Select
    test = 0
    If Documents.Count = 0 Then Documents.Add
sohr:
    Set dlg1 = Dialogs(wdDialogCopyFile)
    Set dlg2 = Dialogs(wdDialogDocumentStatistics)
    If w1 = 0 Then
        hh = dlg1.Display
        If hh <> -1 Then GoTo bye
        A$ = dlg1.Directory
    End If
    If w1 = 1 Then A$ = dlg2.Directory
    If A$ = "" Then
        kk = MsgBox("Ваш файл не сохранен ни в какой директории. Сохраните его в директории, которую вы намерены каталогизировать.", vbExclamation, "Каталогизатор")
        hh = Dialogs(wdDialogFileSaveAs).Show
        If hh = 0 Then GoTo bye
        GoTo sohr
    End If
    If kartinki = 1 Then ActiveWindow.View.Type = wdOnlineView
    WordBasic.CharRight
    WordBasic.CharLeft
    With Application.FileSearch
        .NewSearch
        If rash$ <> "" Then .FileName = "*." + rash$
        .LookIn = A$
        .SearchSubFolders = False
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
        If tir = 0 Then
            If .Execute = 0 Then GoTo pusto
            GoTo nextt
        End If
        If .Execute(SortBy:=sortir, SortOrder:=sortir2) = 0 Then GoTo pusto
nextt:
        Selection.TypeText Text:=Chr$(13) + "Каталог папки " + A$ + ":" + Chr$(13)
        For qqq = 1 To .FoundFiles.Count
            ii$ = .FoundFiles(qqq)
            iires$ = ii$
            If w2 = 1 Then ii$ = Dir(ii$)
            On Error GoTo dal
            ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=ii$, SubAddress:=""
            Selection.TypeText Text:=" - "
            Selection.TypeParagraph
            If kartinki = 1 Then
                iil$ = Right(ii$, 4)
                If iil$ = ".gif" Or iil$ = ".jpg" Or iil$ = "jpeg" Or iil$ = ".JPG" Or iil$ = "JPEG" Or iil$ = ".GIF " Then
                    nalkar = 1
                    Selection.TypeText Text:=" "
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1
                    ActiveDocument.Shapes.AddPicture Anchor:=Selection.Range, FileName:=iires$, LinkToFile:=l1, SaveWithDocument:=l2
                    test = 1
                    Selection.Delete Unit:=wdCharacter, Count:=1
                End If
            End If
            For bbb = 1 To abzac
                Selection.TypeParagraph
            Next bbb
dal:
        Next qqq
    End With
    hhhhh$ = "Для создания каталога картинок без их копирования используйте макрокоманду КаталогКартинок."
    If kartinki = 1 And nalkar = 1 Then eee$ = Chr$(9) + "В настоящее время используется режим просмотра электронного документа, для перехода к другому режиму просмотра используйте меню Вид." + Chr$(13) + Chr$(9) + "Помните, что из-за особенностей сохранения документа в формате HTML средствами Microsoft Word при таком сохранении все вставленные картинки будут скопированы в ту директорию, где находится данный документ, под именами ImagesXX." + hhhhh$ Else eee$ = ""
    jjj = MsgBox(Chr$(9) + "Каталогизация файлов произведена. Для создания Web-страницы сохраните полученный документ в формате HTML." + eee$, 64, "Каталогизация произведена")
    GoTo bye
pusto:
    qwe = MsgBox("В указанной директории нет каталогизируемых файлов. ", 16, "Каталогизатор")
    GoTo bye
bye:
End Sub
Делай, что можешь, и будь, что будет!

2

Re: Крякозябры в формах создаваемых кодом

Картинка

Post's attachments

15-24-09.PNG 27.02 Кб, файл не был скачан. 

You don't have the permssions to download the attachments of this post.
Делай, что можешь, и будь, что будет!

3

Re: Крякозябры в формах создаваемых кодом

Файлик прислать можете?

4

Re: Крякозябры в формах создаваемых кодом

Кафтан не мой...
внешняя ссылка
кстати, там есть еще пару интересных макросов... рекомендую..

Делай, что можешь, и будь, что будет!