Office関連 | 初心者備忘録

Archive for the ‘Office関連’ Category

クラシックスタイルメニュー for Office 2010について

2011/07/03

Office 2007と2010にOffice 2003のようなメニューやツールバーを追加するソフト「クラシックスタイルメニュー for Office 2010」を公開していますが、先日アンケートを作成しました。

このアンケートやメールで何点かご要望をいただきましたので、今回はそれに対する回答として記事を書いてみます(内容は随時追加予定)。

2013/01/10 当記事は下記ページに移行しました。

・クラシックスタイルメニュー
http://www.ka-net.org/blog/?page_id=2546

カテゴリー: リボン関連, Office関連 | 2 Comments »

UndoRecordオブジェクトの使用例

2011/05/03

「ユーザー設定の「元に戻す」機能を使用する(Word 2010 VBA)」でWord 2010で新たに追加されたUndoRecordオブジェクトを紹介していますが、今回はその使用例を紹介します。

Option Explicit

Public Sub Sample()
  Dim ur As Word.UndoRecord
  
  MsgBox "処理を実行します。", vbInformation
  Set ur = Application.UndoRecord
  ur.StartCustomRecord "My Custom Undo"
  
  '----------------------
  '一連の処理
  '----------------------
  Selection.TypeText "A"
  Selection.TypeParagraph
  Selection.TypeText "B"
  Selection.TypeParagraph
  Selection.TypeText "C"
  Selection.TypeParagraph
  Selection.TypeText "D"
  Selection.TypeParagraph
  Selection.TypeText "E"
  Selection.TypeParagraph
  Selection.TypeText "F"
  Selection.TypeParagraph
  '----------------------
  
  ur.EndCustomRecord
  If MsgBox("一連の処理を取り消しますか？", vbYesNo) = vbYes Then ActiveDocument.Undo
  Set ur = Nothing
End Sub

上記はほんの一例ですが、処理前にStartCustomRecordメソッドを入れることで、処理後にまとめて取り消すことができるようになります。

カテゴリー: Office関連 | Leave a Comment »

IME 2010 「DQNネーム辞書」(オープン拡張辞書)公開

2011/05/02

2012/02/23 辞書を更新しました。
詳細は「「DQNネーム辞書」を更新しました。」から。

DQNネーム（子供の名前＠あー勘違い・子供がカワイソ）に登録されているDQNネームを登録したオープン拡張辞書を作成しましたので、下記リンクにて公開します。
辞書登録時のエラーチェックやフィルタリングで一部引っかかってしまいますが、2つの辞書合わせて約19,000個の名前を収録しています。

http://cid-92a165759188b352.office.live.com/browse.aspx/.Public/dctxc

公開を承諾してくださったDQNネーム管理者様にはこの場を借りてお礼申し上げます。

オープン拡張辞書の詳細や登録方法については下記リンクをご参照ください。

「オープン拡張辞書を追加する」
http://pc.nikkeibp.co.jp/article/technique/20100510/1024767/
「Microsoft Office IME 2010 オープン拡張辞書」
http://www.microsoft.com/japan/office/2010/ime/open-extended-dictionary.mspx

カテゴリー: Office関連 | 1 Comment »

Excel 97でCALL関数をワークシート上から使ってみました。

2011/04/17

「VBScriptからWindows API関数を呼び出す」でExcelのCALL関数を紹介しましたが、Excel 97でワークシート上から使ってみたのでスクリーンショットを掲載。

この関数がSUM関数やVLOOKUP関数などの関数と同様にワークシート上からも普通に使えるのはやはり危険ですね。
(2000以降ではワークシート上からの呼び出しができなくなっています。)

カテゴリー: Office関連 | Leave a Comment »

Excel 2010でページ設定(PageSetup)の動作を高速化する

2011/04/16

1年近く前につぶやいた話題ですが、今になっても取り扱っているサイトが少ないので今回記事を書いてみます。

Excel VBAでのページ設定(PageSetup)の動作が遅いことはよく知られたことで、これまでは高速化のためにExcel 4.0(XLM)マクロのPAGE.SETUP()が多くの場面で使われてきました。

Excel 2010では新たに「Application.PrintCommunication」プロパティが追加され、PageSetupプロパティを設定するコードの実行を高速化することができるようになりました。

実際にテストしたコードと結果は下記の通りです(テストしたブックは255シートで、1シートずつループで処理しています)。

Public Sub Test01()
'PrintCommunicationプロパティ無し
  Dim sht As Excel.Worksheet
  Dim t1 As Single, t2 As Single
  
  t1 = Timer
  For Each sht In ActiveWorkbook.Worksheets
    With sht.PageSetup
      .LeftMargin = Application.InchesToPoints(0.25)
      .RightMargin = Application.InchesToPoints(0.25)
      .TopMargin = Application.InchesToPoints(0.75)
      .BottomMargin = Application.InchesToPoints(0.75)
      .Orientation = xlLandscape
      .PaperSize = xlPaperLetter
      .FitToPagesWide = 1
      .FitToPagesTall = 1
    End With
  Next
  t2 = Timer
  MsgBox "Test01処理時間：" & t2 - t1 & "秒"
  Debug.Print t2 - t1
End Sub

Public Sub Test02()
'PrintCommunicationプロパティ有り
  Dim sht As Excel.Worksheet
  Dim t1 As Single, t2 As Single
  
  t1 = Timer
  Application.PrintCommunication = False
  For Each sht In ActiveWorkbook.Worksheets
    With sht.PageSetup
      .LeftMargin = Application.InchesToPoints(0.25)
      .RightMargin = Application.InchesToPoints(0.25)
      .TopMargin = Application.InchesToPoints(0.75)
      .BottomMargin = Application.InchesToPoints(0.75)
      .Orientation = xlLandscape
      .PaperSize = xlPaperLetter
      .FitToPagesWide = 1
      .FitToPagesTall = 1
    End With
  Next
  Application.PrintCommunication = True
  t2 = Timer
  MsgBox "Test02処理時間：" & t2 - t1 & "秒"
  Debug.Print t2 - t1
End Sub

上記結果を見ると確かにPrintCommunicationプロパティを設定した方が早く処理が終わっています。
下記Microsoftのページを見ると、Excel 4.0 マクロから新たに追加された機能への移行が推奨されているようです。

「Excel 4.0 マクロを操作する」
http://office.microsoft.com/ja-jp/excel-help/HA010336614.aspx
「Migrating Excel 4 Macros to VBA」
http://blogs.office.com/b/microsoft-excel/archive/2010/02/16/migrating-excel-4-macros-to-vba.aspx

Excel 2010を使用していて、PageSetupの遅さにお悩みの方は一度試してみてはいかがでしょうか？

カテゴリー: Office関連 | Leave a Comment »

Word 2010に一太郎コンバーターを導入する

2011/04/14

「Word 2010 で廃止、変更される機能」にあるように、Word 2010では一太郎コンバーターが無くなり一太郎ファイルが開けなくなりました(今後コンバーターが提供されるようになる可能性はあります)。

そのかわりとしてよく用いられるのが一太郎ビューアですが、今回はWord 2010に無理矢理一太郎コンバーターを導入する方法を紹介します。

※ 下記に紹介する方法はWord 2007の一太郎コンバーターをWord 2010に導入する方法で、私の方では使用していないOffice 2007のディスクから一太郎コンバーターのみを抜き出して動作を確認しましたが、コンバーターのライセンスについては未確認です。もしかしたらライセンス違反になる可能性もありますので、取り扱いには十分ご注意ください。ライセンス違反であることが確認された場合には当記事も公開を停止します。

※ 下記の方法はWindows 7 Ultimate(64ビット版) + Office 2010(32ビット版)、Windows 7 Ultimate(32ビット版) + Office 2010(32ビット版)上で動作確認を行いました。Office 2010(64ビット版)上ではエラーが発生してコンバータの動作を確認することができませんでした。

[手順]
1. Office 2007のディスク内の「Office.ja-jp」フォルダにある「OfficeLR.cab」ファイルから下記のファイルのみを展開します。
(展開方法はWindows 7であれば右クリックメニュー「プログラムから開く」の「エクスプローラー」からファイルを取り出すことができます。また、cab形式に対応した解凍ソフトを用いることでもファイルを取り出すことができます。)

・JWSPCNV.DLL_0001_1041
・JXW7.DLL_0001_1041
・JXW8.DLL_0001_1041
・RTF_.DLL_0001_1041
・TARO7.CNV_0001_1041
・TARO8.CNV_0001_1041

2. 1.で取り出したファイルの名前をそれぞれ下記のように変更します(ファイル名の「_0001_1041」部分を削除します)。

・JWSPCNV.DLL
・JXW7.DLL
・JXW8.DLL
・RTF_.DLL
・TARO7.CNV
・TARO8.CNV

3. ファイルのプロパティから「読み取り専用」を解除します。

4. 下記テキストコンバーターフォルダにファイルを移動します。

32ビット版OS:C:\Program Files\Common Files\microsoft shared\TextConv
64ビット版OS:C:\program files (x86)\common files\microsoft shared\textconv

5. 「ファイル名を指定して実行」から下記コマンドを実行し、レジストリエディタを起動します。

32ビット版OS:regedit
64ビット版OS:%systemroot%\syswow64\regedit

※ 64ビット環境でのレジストリ編集に関しては「64 ビットバージョンの Windows でシステムレジストリを表示する方法」参照。

6. 下記のようにキーを設定します(キーやデータが存在しない場合は新規作成)。

[キー位置]
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Ichitaro7
[データ:値]
Extensions(タイプ:文字列値):JFW JVW
Name(タイプ:文字列値):一太郎 7
Path(タイプ:文字列値):(手順 4. のテキストコンバーターフォルダのパス)\TARO7.CNV

[キー位置]
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Ichitaro7\NoDialogs
[データ:値]
(既定):(空白)

[キー位置]
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Ichitaro8
[データ:値]
Extensions(タイプ:文字列値):JTD JTT
Name(タイプ:文字列値):一太郎 8-13/2004-2006
Path(タイプ:文字列値):(手順 4. のテキストコンバーターフォルダのパス)\TARO8.CNV

[キー位置]
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Ichitaro8\NoDialogs
[データ:値]
(既定):(空白)

以上で作業は終了です。
以降Wordで一太郎ファイルが開けるようになります。

カテゴリー: Office関連 | 5 Comments »

Google Translate API(v1)で翻訳するマクロ

2011/03/14

参照Webページ:
http://code.google.com/intl/ja/apis/language/translate/overview.html
http://code.google.com/intl/ja/apis/language/translate/v1/getting_started.html#translatableLanguages

Option Explicit

Public Sub Sample()
  With CreateObject("WScript.Shell")
    .Popup TranslateText("This is a pen.") '結果を日本語で表示
    .Popup TranslateText("This is a pen.", "zh") '結果を中国語で表示
    .Popup TranslateText("これはペンです。", "ar") '結果をアラビア語で表示
  End With
End Sub

Public Function TranslateText(ByVal target As String, Optional ByVal destLang As String = "ja") As String
'Google Translate API(v1)で翻訳(翻訳元言語:自動認識 , 翻訳先言語:destLangで指定(標準では日本語(ja)))
  Dim url As String
  Dim js As String
  Dim ret As String
  
  destLang = StrConv(destLang, vbNarrow)
  destLang = LCase$(destLang)
  If ChkLang(destLang) = False Then
    MsgBox "翻訳先言語が対応していません。" & vbCrLf & "処理を中止します。", vbExclamation + vbSystemModal
    Exit Function
  End If
  target = EncodeURL(target)
  
  js = "" '初期化
  url = "https://ajax.googleapis.com/ajax/services/language/translate?v=1.0&q=" & target & "&langpair=%7C" & destLang
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .Send
    js = .responseText
  End With
  On Error GoTo 0
  If Len(js) < 1 Then Exit Function
  
  ret = GetTranslatedText(js)
  If Len(ret) < 1 Then ret = "Error"
  
  TranslateText = ret
End Function

Private Function EncodeURL(ByVal sWord As String) As String
'URLエンコード
  Dim d As Object
  Dim elm As Object
  
  Set d = CreateObject("htmlfile")
  Set elm = d.createElement("span")
  elm.setAttribute "id", "result"
  d.body.appendChild elm
  d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & sWord & "');", "JScript"
  EncodeURL = elm.innerText
End Function

Private Function GetTranslatedText(ByVal js As String) As String
'JSONデータから訳語取得
  Dim d As Object
  Dim elm As Object
    
  js = "(" & js & ")"
  Set d = CreateObject("htmlfile")
  Set elm = d.createElement("span")
  elm.setAttribute "id", "result"
  d.body.appendChild elm
  d.parentWindow.execScript "document.getElementById('result').innerText=eval(" & js & ").responseData.translatedText;"
  
  GetTranslatedText = elm.innerText
End Function

Private Function ChkLang(ByVal lng As String) As Boolean
'対応言語チェック
  Dim LngList(55) As String
  Dim ret As Boolean
  Dim i As Long
  
  LngList(0) = "af" 'AFRIKAANS
  LngList(1) = "ar" 'ARABIC
  LngList(2) = "be" 'BELARUSIAN
  LngList(3) = "bg" 'BULGARIAN
  LngList(4) = "ca" 'CATALAN
  LngList(5) = "cs" 'CZECH
  LngList(6) = "cy" 'WELSH
  LngList(7) = "da" 'DANISH
  LngList(8) = "de" 'GERMAN
  LngList(9) = "el" 'GREEK
  LngList(10) = "en" 'ENGLISH
  LngList(11) = "es" 'SPANISH
  LngList(12) = "et" 'ESTONIAN
  LngList(13) = "fa" 'PERSIAN
  LngList(14) = "fi" 'FINNISH
  LngList(15) = "fr" 'FRENCH
  LngList(16) = "ga" 'IRISH
  LngList(17) = "gl" 'GALICIAN
  LngList(18) = "hi" 'HINDI
  LngList(19) = "hr" 'CROATIAN
  LngList(20) = "ht" 'HAITIAN_CREOLE
  LngList(21) = "hu" 'HUNGARIAN
  LngList(22) = "id" 'INDONESIAN
  LngList(23) = "is" 'ICELANDIC
  LngList(24) = "it" 'ITALIAN
  LngList(25) = "iw" 'HEBREW
  LngList(26) = "ja" 'JAPANESE
  LngList(27) = "ko" 'KOREAN
  LngList(28) = "lt" 'LITHUANIAN
  LngList(29) = "lv" 'LATVIAN
  LngList(30) = "mk" 'MACEDONIAN
  LngList(31) = "ms" 'MALAY
  LngList(32) = "mt" 'MALTESE
  LngList(33) = "nl" 'DUTCH
  LngList(34) = "no" 'NORWEGIAN
  LngList(35) = "pl" 'POLISH
  LngList(36) = "pt" 'PORTUGUESE
  LngList(37) = "pt-pt" 'PORTUGUESE_PORTUGAL
  LngList(38) = "ro" 'ROMANIAN
  LngList(39) = "ru" 'RUSSIAN
  LngList(40) = "sk" 'SLOVAK
  LngList(41) = "sl" 'SLOVENIAN
  LngList(42) = "sq" 'ALBANIAN
  LngList(43) = "sr" 'SERBIAN
  LngList(44) = "sv" 'SWEDISH
  LngList(45) = "sw" 'SWAHILI
  LngList(46) = "th" 'THAI
  LngList(47) = "tl" 'TAGALOG
  LngList(48) = "tl" 'FILIPINO
  LngList(49) = "tr" 'TURKISH
  LngList(50) = "uk" 'UKRAINIAN
  LngList(51) = "vi" 'VIETNAMESE
  LngList(52) = "yi" 'YIDDISH
  LngList(53) = "zh" 'CHINESE
  LngList(54) = "zh-cn" 'CHINESE_SIMPLIFIED
  LngList(55) = "zh-tw" 'CHINESE_TRADITIONAL
  
  ret = False ' 初期化
  For i = LBound(LngList) To UBound(LngList)
    If lng = LngList(i) Then
      ret = True
      Exit For
    End If
  Next
  
  ChkLang = ret
End Function

カテゴリー: コピー&ペースト用, Office関連 | Leave a Comment »

ExportAsFixedFormatでPDFを作成する

2011/03/07

2年近く前に書いたコードを掲載してみます。

Sub Sample()
  Const FilePath As String = "M:\Test.pdf"
   
  'ブックごとPDF化
  ThisWorkbook.ExportAsFixedFormat xlTypePDF, FilePath, xlQualityStandard
  'シートごとPDF化
  'ActiveSheet.ExportAsFixedFormat xlTypePDF, FilePath, xlQualityStandard
  '選択した範囲のみPDF化
  'Selection.ExportAsFixedFormat xlTypePDF, FilePath, xlQualityStandard
  '範囲が飛び飛びだった場合:連続したセル範囲/1ページ のPDF作成
  'ActiveSheet.Range("A1,B3,C5").ExportAsFixedFormat xlTypePDF, FilePath, xlQualityStandard
End Sub

「ExportAsFixedFormat Method [Excel 2007 Developer Reference]」
http://msdn.microsoft.com/en-us/library/bb238907.aspx

カテゴリー: コピー&ペースト用, Office関連 | Leave a Comment »

動的にJavaScriptを実行する

2011/03/07

「JavaScriptを動的に書き出す」参照。

Public Sub Sample()
  Dim d As Object
  Dim oDiv As Object
  
  Set d = CreateObject("htmlfile")
  Set oDiv = d.createElement("div")
  oDiv.innerHTML = "&nbsp;<script defer>alert(document.parentWindow.clientInformation.userAgent);</script>"
  d.body.appendChild oDiv
End Sub

カテゴリー: コピー&ペースト用, Office関連 | Leave a Comment »

APIで郵便番号から住所を取得する(2)

2011/03/07

今回はGroove Technologyが提供しているAPIで住所検索してみます。
郵便番号から住所、住所から郵便番号の取得が可能。

Option Explicit
Option Base 1

Private Type Address
  zipcode As String '郵便番号
  add As String '住所
  addk As String '住所(カナ)
End Type

Public Sub Sample()
  Dim ad() As Address, ad2() As Address
  Dim count As Long, count2 As Long
  Dim i As Long, j As Long
  
  '郵便番号による住所検索
  ad() = AddressByZipCodeOrAddress("111")
  On Error Resume Next
  count = UBound(ad)
  If Err.Number <> 0 Then
    MsgBox "住所を取得できませんでした。", vbCritical + vbSystemModal
    Err.Clear
    Exit Sub
  End If
  On Error GoTo 0
  For i = LBound(ad) To count
    Debug.Print ad(i).zipcode, ad(i).add, ad(i).addk
  Next
  
  Debug.Print "--------------------"
  
  '住所の一部による住所検索
  ad2() = AddressByZipCodeOrAddress("沖縄県那覇市首里", 2)
  On Error Resume Next
  count2 = UBound(ad2)
  If Err.Number <> 0 Then
    MsgBox "住所を取得できませんでした。", vbCritical + vbSystemModal
    Err.Clear
    Exit Sub
  End If
  On Error GoTo 0
  For j = LBound(ad2) To count2
    Debug.Print ad2(j).zipcode, ad2(j).add, ad2(j).addk
  Next
End Sub

Private Function AddressByZipCodeOrAddress(ByVal param As String, Optional ByVal mode As Long = 1) As Address()
'郵便番号もしくは住所の一部から住所を取得
'引数 mode 1:郵便番号 , 2:住所の一部(漢字、ひらがな、カタカナ)
  Dim ad() As Address
  Dim oXML As Object, oNode As Object
  Dim url As String, tmpZipcode As String
  Dim count As Long, i As Long
  
  url = "http://groovetechnology.co.jp/ZipSearchService/v1/zipsearch?format=xml&ie=UTF-8&oe=UTF-8"
  Select Case mode
    Case 1
      url = url & "&zipcode=" & param
    Case 2
      url = url & "&word=" & EncodeURL(param)
    Case Else
      MsgBox "不正なパラメータです。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
      Exit Function
  End Select
  
  count = 0: i = 1 '初期化
  On Error Resume Next
  Set oXML = Nothing
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .Send
    Set oXML = .responseXML
  End With
  Err.Clear
  On Error GoTo 0
  If oXML Is Nothing Then Exit Function
  If Len(oXML.XML) < 1 Then Exit Function
  count = oXML.SelectNodes("/groovewebservice/address").Length
  If count < 1 Then Exit Function
  
  ReDim ad(count)
  For Each oNode In oXML.SelectNodes("/groovewebservice/address")
    tmpZipcode = oNode.SelectSingleNode("zipcode").Text
    tmpZipcode = Left$(tmpZipcode, 3&) & "-" & Right$(tmpZipcode, 4&)
    ad(i).zipcode = tmpZipcode
    ad(i).add = oNode.SelectSingleNode("prefecture").Text & _
                oNode.SelectSingleNode("city").Text & _
                oNode.SelectSingleNode("town").Text
    ad(i).addk = oNode.SelectSingleNode("prefecture_yomi").Text & _
                 oNode.SelectSingleNode("city_yomi").Text & _
                 oNode.SelectSingleNode("town_yomi").Text
    i = i + 1
  Next
  
  AddressByZipCodeOrAddress = ad()
End Function

Private Function EncodeURL(ByVal sWord As String) As String
  Dim d As Object
  Dim elm As Object
  
  Set d = CreateObject("htmlfile")
  Set elm = d.createElement("span")
  elm.setAttribute "id", "result"
  d.body.appendChild elm
  d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & sWord & "');", "JScript"
  EncodeURL = elm.innerText
End Function

カテゴリー: Office関連 | Leave a Comment »

初心者備忘録

Archive for the ‘Office関連’ Category

クラシックスタイルメニュー for Office 2010について

UndoRecordオブジェクトの使用例

IME 2010 「DQNネーム辞書」(オープン拡張辞書)公開

Excel 97でCALL関数をワークシート上から使ってみました。

Excel 2010でページ設定(PageSetup)の動作を高速化する

Word 2010に一太郎コンバーターを導入する

Google Translate API(v1)で翻訳するマクロ

ExportAsFixedFormatでPDFを作成する

動的にJavaScriptを実行する

APIで郵便番号から住所を取得する(2)

カテゴリー

アーカイブ

ホームページ

@kinuasa