Top > OOobbs2 > 86

OOobbs2/86 Edit

  • サマリ: ショートカットキー設定を無理やりドキュメントファイルに押し込む
  • 環境: General
  • 状態: 投稿
  • 投稿者: はにゃ??
  • 投稿日: 2007-11-21 (水) 03:38:21

質問 Edit

OpenOffice.org のショートカットキー設定はファイルに保存できません。が、設定ファイルをエクスポートできるのに加えて、ドキュメントファイルにキー設定を保存するファイルが存在します。

こっちのほうが楽。でも、GUI がほしいところ・・・。

  0
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
Dim oShortCutMgr As Object
 
Sub Main
  oDoc = ThisComponent
  oUICfgMgr = oDoc.UIConfigurationManager
  If NOT IsNull(oUICfgMgr) Then
    oShortCutMgr = oUICfgMgr.getShortCutManager()
    
    'RemoveKeyEvent(771,True,True)
    SetKeyEvent(771,".uno:About",True,True)
    
     ' store the configuration to the document
    oShortCutMgr.store()
  End If
End Sub
 
' nKeyCode: com.sun.star.awt.KeyCode
' sCommand: CommandURL
' bShift: with Shift key, bCtrl: with Ctrl key
Sub SetKeyEvent( nKeyCode As Long, sCommand As String, _
        Optional bShift As Boolean, Optional bCtrl As Boolean )
  If IsMissing(bShift) Then bShift = False
  If IsMissing(bCtrl) Then bCtrl = False
  nModifire = 0
  KeyModifier = com.sun.star.awt.KeyModifier
  If bShift Then nModifire = nModifire + KeyModifier.SHIFT
  If bCtrl  Then nModifire = nModifire + KeyModifier.MOD1
  
  aKeyEvent = CreateUnoStruct("com.sun.star.awt.KeyEvent")
  aKeyEvent.KeyCode = nKeyCode
  aKeyEvent.Modifiers = nModifire
  oShortCutMgr.setKeyEvent(aKeyEvent,sCommand)
End Sub
 
' nKeyCode: com.sun.star.awt.KeyCode
' bShift: with Shift key, bCtrl: with Ctrl key
Sub RemoveKeyEvent( nKeyCode As Long, _
           Optional bShift As Boolean, Optional bCtrl As Boolean )
  If IsMissing(bShift) Then bShift = False
  If IsMissing(bCtrl) Then bCtrl = False
  nModifire = 0
  KeyModifier = com.sun.star.awt.KeyModifier
  If bShift Then nModifire = nModifire + KeyModifier.SHIFT
  If bCtrl  Then nModifire = nModifire + KeyModifier.MOD1
  
  aKeyEvent = CreateUnoStruct("com.sun.star.awt.KeyEvent")
  aKeyEvent.KeyCode = nKeyCode
  aKeyEvent.Modifiers = nModifire
  oShortCutMgr.removeKeyEvent(aKeyEvent)
End Sub

エクスポートしたファイルからキー設定をドキュメントに無理やり押し込みます。

  1. 適当にドキュメントファイルを用意します。コピーで試しましょう。
  2. 同じ種類のファイルを新規作成し、ツール - カスタマイズ - キーボードでキーボード設定を変更します。変更したら、OK を押さずに次の操作へ。
  3. そのダイアログにある保存ボタンを押してショートカットキーを保存します。
  4. 次の PutKeyConfigurationToDoc マクロを実行します。

PutKeyConfigurationToDoc を実行し、最初のファイル選択ダイアログで上記で保存した設定ファイルを選択します。二番目に表示されるファイル選択ダイアログでキー設定を押し込みたいドキュメントファイルを選択します。

ファイルが壊れる可能性があるので自己責任でどうぞ。 もちろん、このようにして設定を変更したファイルのキー設定はアプリケーションの設定を変更してもファイルに適用されません。

  0
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
Sub PutKeyConfigurationToDoc
  sKeyConfigURL = GetFileURL( _
    "Select a key configuration file.")
  wait(300)
  If sKeyConfigURL = "" Then Exit Sub
  sDocFileURL = GetFileURL( _
    "Select a document file to put into the key configuration.")
  If sDocFileURL = "" Then Exit Sub
  oSFAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
  If oSFAccess.exists(sKeyConfigURL) AND oSFAccess.exists(sDocFileURL) Then
  
    oKeyConfigInput = GetZipContentStream(sKeyConfigURL)
    If IsNull(oKeyConfigInput) Then
      msgbox sKeyConfigURL & " file does not have the configuration file."
    End If
    If PutZipContentStream(sDocFileURL,oKeyConfigInput) Then
      msgbox "Done."
    End If
    oKeyConfigInput.closeInput()
  End If
End Sub
 
' select a file
Function GetFileURL( sTitle As String )
  Dim oFilePicker As Object
  Dim sFileURL As String
  oFilePicker = CreateUnoService( _
      "com.sun.star.ui.dialogs.FilePicker")
  oFilePicker.setTitle(sTitle)
  If oFilePicker.execute() = 1 Then
    sFileNames = oFilePicker.getFiles()
    sFileURL = sFileNames(0)
  End Function
  GetFileURL = sFileURL
End Function
 
' get inputstream from zip
Function GetZipContentStream( sZipURL As String )
  Dim oZipPkg As Object, oSFA As Object
  Dim oContentStream As Object, oInput As Object
  sContentName = "Configurations2/accelerator/current.xml"
  oZipPkg = CreateUnoService("com.sun.star.packages.Package")
  oZipPkg.initialize(array(sZipURL))
  If oZipPkg.hasByHierarchicalName(sContentName) Then
    oContentStream = oZipPkg.getByHierarchicalName(sContentName)
    oInput = oContentStream.getInputStream()
  Else
    msgbox "Key configuration file does not exist."
  End If
    GetZipContentStream = oInput
End Function
 
' put file into zip from inputstream
Function PutZipContentStream( sZipURL As String, _
  oInputStream As Object )
  On Error GoTo Handler:
  If NOT IsNull(oInputStream) Then
    Dim oZipPkg As Object, oSFA As Object
    Dim oContentStream As Object, oZipFolder As Object
    sSettingFile = "current.xml"
    sSettingDir = "Configurations2/accelerator"
    oZipPkg = CreateUnoService("com.sun.star.packages.Package")
    oZipPkg.initialize(array(sZipURL))
    If NOT oZipPkg.hasByHierarchicalName(sSettingDir) Then
      PutZipContentStream = False
      Exit Function
    End If
    oZipFolder = oZipPkg.getByHierarchicalName(sSettingDir)
    oContentStream = oZipPkg.createInstanceWithArguments(array(false))
    oContentStream.setInputStream(oInputStream)
    If NOT oZipFolder.hasByName(sSettingFile) Then
      oZipFolder.insertByName(sSettingFile,oContentStream)
    Else
      oZipFolder.replaceByName(sSettingFile,oContentStream)
    End If
    oZipPkg.commitChanges()
  End If
  PutZipContentStream = True
  Exit Function
  Handler:
  msgbox "Please close the file."
  PutZipContentStream = False
End Function

押し込んだキー設定を削除するためのマクロ。実行して設定を取り除きたいドキュメントファイルを選択します。

  0
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
' remove key configuration file
Sub RemoveKeyConfigurationFromDoc()
  sFileURL = GetFileURL( _
    "Select a file you want to remove the key configuration.")
  If sFileURL = "" Then Exit Sub
  oSFAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
  If oSFAccess.exists(sFileURL) Then
    If RemoveZipFileContent(sFileURL,sKeyConfigFile) Then
      msgbox "Removed."
    End If
  End If
End Sub
 
' remove the key configuration file from zip
Function RemoveZipFileContent( sZipURL As String, _
  sContentName As String )
  'On Error GoTo Handler:
  If NOT IsNull(oInputStream) Then
    Dim oZipPkg As Object, oSFA As Object
    Dim oContentStream As Object, oZipFolder As Object
    sSettingFile = "current.xml"
    sSettingDir = "Configurations2/accelerator"
    oZipPkg = CreateUnoService("com.sun.star.packages.Package")
    oZipPkg.initialize(array(sZipURL))
    If NOT oZipPkg.hasByHierarchicalName(sSettingDir) Then
      PutZipContentStream = False
      Exit Function
    End If
    oZipFolder = oZipPkg.getByHierarchicalName(sSettingDir)
    oContentStream = oZipPkg.createInstanceWithArguments(array(false))
    oPipe = CreateUnoService("com.sun.star.io.Pipe")
    oPipe.writeBytes(Array())
    oPipe.flush()
    oPipe.closeOutput()
    oContentStream.setInputStream(oPipe)
    
    If oZipFolder.hasByName(sSettingFile) Then
      oZipFolder.replaceByName(sSettingFile,oContentStream)
      oZipPkg.commitChanges()
    End If
    oPipe.closeInput()
  End If
  RemoveZipFileContent = True
  Exit Function
  Handler:
  msgbox "Please close the file."
  RemoveZipFileContent = False
End Function
 
' select a file
Function GetFileURL( sTitle As String )
  Dim oFilePicker As Object
  Dim sFileURL As String
  oFilePicker = CreateUnoService( _
      "com.sun.star.ui.dialogs.FilePicker")
  oFilePicker.setTitle(sTitle)
  If oFilePicker.execute() = 1 Then
    sFileNames = oFilePicker.getFiles()
    sFileURL = sFileNames(0)
  End Function
  GetFileURL = sFileURL
End Function

回答 Edit

なし


感想,コメント,メモ Edit



Reload   New Lower page making Edit Freeze Diff Upload Copy Rename   Front page List of pages Search Recent changes Backup   Help   RSS of recent changes