В надстройке Disser реализована автоматическая замена одинарной скобки на двойную. Но я в макросописании не силен, не могу разобраться как это реализовано. Надеюсь, это не будет каким-либо нарушением, если я вставлю в это сообщение код из макроса, который, к слову сказать, никак не запаролирован. Вот он:
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function GetKeyboardLayout Lib "user32" (ByVal pThread As Long) As Long
Declare Function WinHelpA Lib "user32" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
Const EN = 67699721
Sub SetupAddit()
frmSetup.Show
End Sub
Sub AutoExec()
On Error GoTo 1
Application.Caption = GetSetting("Disser", "Ïàðàìåòðû", "Çàãîëîâîê", "")
WordBasic.DisableAutoMacros GetSetting("Disser", "Ïàðàìåòðû", "DisableAutoMacros", "Íåò") <> "Íåò"
If GetSetting("Disser", "Ïàðàìåòðû", "SaveDeskTop", "Íåò") <> "Íåò" Then
MySettings = GetAllSettings("Disser", "SaveDeskTop")
For intSettings = LBound(MySettings) To UBound(MySettings)
Documents.Open MySettings(intSettings, 0), Revert:=False
Application.GoBack
Next intSettings
End If
1
End Sub
Sub AutoNew()
On Error Resume Next
If GetSetting("Disser", "Ïàðàìåòðû", "InformBlocks", "Íåò") <> "Íåò" Then
ActiveDocument.Variables.Add "AdditOptions", Chr(32 Or IIf(GetSetting("Disser", "Ïàðàìåòðû", "InformBlocks", "Íåò") <> "Íåò", 1, 0) Or IIf(GetSetting("Disser", "Ïàðàìåòðû", "ExcludeDouble", "Íåò") <> "Íåò", 2, 0))
End If
End Sub
Sub AutoExit()
On Error Resume Next
If GetSetting("Disser", "Ïàðàìåòðû", "SaveDeskTop", "Íåò") <> "Íåò" Then
DeleteSetting "Disser", "SaveDeskTop"
For Each Doc In Application.Documents
Doc.Activate
SaveSetting "Disser", "SaveDeskTop", Doc.FullName, ""
Next Doc
End If
End Sub
Sub HelpAddit()
On Error Resume Next
WinHelpA 0, "Disser.hlp", 1, 1
End Sub
Sub TipsAndTricks()
On Error Resume Next
WinHelpA 0, "Disser.hlp", 1, 15
End Sub
Sub ShowMetodic()
On Error Resume Next
Documents.Open GetSetting("Disser", "Ïàðàìåòðû", "Ðàñïîëîæåíèå", "c:\program files\ÏÊ") & "\ìåòîäè÷êà.doc"
End Sub
Sub ShiftSave()
On Error Resume Next
If GetAsyncKeyState(&H10) Then Documents.Save Else ActiveDocument.Save
End Sub
Sub RoundBrackets()
On Error Resume Next
Selection.TypeText "()"
Selection.MoveLeft
End Sub
Sub FrenchQuatationMarks()
On Error Resume Next
If GetKeyboardLayout(0) <> EN Then
Selection.TypeText "«»": Selection.MoveLeft
Else
Selection.TypeText "@"
End If
End Sub
Sub GermQuatationMarks()
On Error Resume Next
Selection.TypeText "„“"
Selection.MoveLeft
End Sub
Sub Brackets()
On Error Resume Next
If GetKeyboardLayout(0) <> EN Then
If Application.CapsLock Then Selection.TypeText "Õ" Else Selection.TypeText "õ"
Else
Selection.TypeText "[]": Selection.MoveLeft
End If
End Sub
Sub CurveBrackets()
On Error Resume Next
If GetKeyboardLayout(0) <> EN Then
If Application.CapsLock Then Selection.TypeText "õ" Else Selection.TypeText "Õ"
Else
Selection.TypeText "{}": Selection.MoveLeft
End If
End Sub
Sub InsertCaption()
On Error Resume Next
ExecDialog wdDialogInsertCaption
End Sub
Sub ToolsEnvelopesAndLabels()
On Error Resume Next
ExecDialog wdDialogToolsEnvelopesAndLabels
End Sub
Sub ExecDialog(D As Long)
Dim Brackets As Boolean, AutoMark As Boolean
On Error GoTo 1
A$ = KeyBindings.Key(313).Command
Brackets = True
KeyBindings.Key(306).Clear: KeyBindings.Key(313).Clear
KeyBindings.Key(562).Clear: KeyBindings.Key(219).Clear
KeyBindings.Key(475).Clear
1
On Error GoTo 2
A$ = KeyBindings.Key(wdKeyReturn).Command
AutoMark = True
KeyBindings.Key(wdKeyReturn).Clear
2
On Error Resume Next
Dialogs(D).Show
If Brackets Then
KeyBindings.Add wdKeyCategoryMacro, "MainM.FrenchQuatationMarks", 306
KeyBindings.Add wdKeyCategoryMacro, "MainM.GermQuatationMarks", 562
KeyBindings.Add wdKeyCategoryMacro, "MainM.RoundBrackets", 313
KeyBindings.Add wdKeyCategoryMacro, "MainM.Brackets", 219
KeyBindings.Add wdKeyCategoryMacro, "MainM.CurveBrackets", 475
End If
If AutoMark Then KeyBindings.Add wdKeyCategoryMacro, "Refer.VVV", wdKeyReturn
End Sub
Похоже, этот код отвечает за замену:
Sub RoundBrackets()
On Error Resume Next
Selection.TypeText "()"
Selection.MoveLeft
End Sub
Это она и есть, автоматическая замена?