Excel

2016年3月16日 (水)

3ステップ(3行)でExcelのVBAでAdobe PDFを使ってPDFを作成する

ExcelのVBAにてAcrobatでPDFファイルを作成する方法。

条件は以下の通り
・プリンタ名は"Adobe PDF"
・プリンターポートは"Ne03"
・出力フォルダは"C:\tmp"
・ファイル名は"test.ps"および"test.pdf"
・出力するシートは現在選択されているシート

以下のコードはExcel 2007とAdobe Acrobat X Standardで動作確認しました。

Sub makePDF()     Application.ActivePrinter = "Adobe PDF on Ne03:"     ActiveWindow.SelectedSheets.PrintOut _         Copies:=1, _         preview:=False, _         printtofile:=True, _         collate:=True, _         prtofileName:="C:\tmp\test.ps"     CreateObject("PdfDistiller.PdfDistiller.1").FileToPDF _
       "C:\tmp\test.ps", _        "C:\tmp\test.pdf", _        vbNullString End Sub

プリンターのポート番号はレジストリの
[HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Devices]
に一覧があります。

2014年9月27日 (土)

Excel VBAでUnicodeでファイル出力する

Excel VBAでUnicodeでファイル出力するサンプルです。

実行前にADODBを使用できるようにする。
「ツール」の「参照設定」
「Microsoft ActiveX Data Objects 6.1 Library」を選択

Sub test_main()

    ' 出力ファイル名を生成
    fName = ActiveWorkbook.Name
    fName = Left(fName, InStrRev(fName, ".") - 1)
    fName = ActiveWorkbook.Path & "\" & fName & ".txt"  'BOOK名のテキストファイル

    ' ストリームを準備
    Dim outStream As ADODB.Stream
    Set outStream = New ADODB.Stream
    With outStream
        .Type = adTypeText
        .Charset = "UTF-16"
        .LineSeparator = adCRLF
    End With
    outStream.Open

    ' ストリームに文字を書き込む
    outStream.WriteText "Hello World!.", adWriteLine

    ' ストリームを書き出して終了する。
    outStream.SaveToFile fName, adSaveCreateOverWrite
    outStream.Close
    Set outStream = Nothing

End Sub

2014年9月26日 (金)

Excel VBAで正規表現による文字列の置換

' 正規表現による文字列の置換

Sub test()

    Dim reg
    Dim pat As String
    Dim v1 As String
    Dim v2 As String
    Dim rep As String

    '検索対象
    v1 = "abc〔1.0,2.0〕/def〔3.0,4.0〕"
    '検索パターン
    pat = "(〔|〕/|〕)"         ' "〔"と"〕/"と"〕"を
    '置換後の文字列                    ↓
    v2 = ","                    ' ","に置換する

    'オブジェクト作成
    Set reg = CreateObject("VBScript.RegExp")

    '正規表現オブジェクトの設定
    With reg
        .Pattern = pat     'パターンを設定します
        .IgnoreCase = True '大文字と小文字を区別するFalseか、しないTrueか
        .Global = True       '文字列全体を検索するTrueか、しないFalseか
    End With

    '正規表現による置換の実行
    rep = reg.Replace(v1, v2)

    '結果ダイアログを出力
    MsgBox rep

    'おまけ:splitでデータを分解
    ret = Split(rep, ",")
    MsgBox ret(0) & vbCrLf & ret(1) & vbCrLf & ret(2) & vbCrLf & _
           ret(3) & vbCrLf & ret(4) & vbCrLf & ret(5)

End Sub