#author("2018-06-11T19:09:56+09:00","default:mat2umoto","mat2umoto")
#author("2018-06-11T19:14:49+09:00","default:mat2umoto","mat2umoto")
#contents

*記法 [#e7c8f93d]
**複数行プラグイン [#e7c8b121]
複数行プラグインの引数に連続した'{'を記述する場合は、引数を囲むために使用する'{'の数を変更する。
 #xxx{{{
 ...}}...
 }}}

**特殊記号のエスケープ [#nb9bfb23]
数値参照文字を使用することで、疑似的にエスケープすることができる。~

例)取消線~
以下のように記述すると、取り消し線と見なされてしまう。(%%hogehoege%%)~
 %%hogehoge%%
以下のように「%」を文字コードで指定することで、記号をそのまま表示されることができる。(%%hogehoge%%)
 %%hogehoge%%

*便利ツール [#w87a5866]
**Excelの表をPukiwiki記法に変換するマクロ [#tfee8dac]
以下の関数をExcelマクロとして実行すると、変換した文字列型が返る。

-注意点
--ヘッダ行の末尾の h は付与されないため、適宜追加が必要
--書式設定行も必要であれば追加が必要
--ヘッダ/フッタ行の末尾の h/f は付与されないため、適宜追加が必要
--書式設定行(末尾c)も必要であれば追加が必要

#code(vb){{
' *****************************************
' 選択範囲のセルからPukiwiki記法の表に変換
' 
' 引数:
'   blWithFormat    書式の有無
' 戻り値:
'   Pukiwiki記法に変換した文字列
' *****************************************
Private Function ConvertPukiWiki( _
    ByVal blWithFormat As Boolean _
) As String

    Dim strResult As String         ' PukiWiki記法文字列
    Dim intRowS As Integer          ' 範囲開始行
    Dim intRowE As Integer          ' 範囲終了行
    Dim intColS As Integer          ' 範囲開始列
    Dim intColE As Integer          ' 範囲終了列
    Dim intRow As Integer           ' 行ループカウンタ
    Dim intCol As Integer           ' 列ループカウンタ
    Dim blMargeUpRow As Boolean     ' 上の行と連結するフラグ
    Dim blMargeRightCol As Boolean  ' 右の列と連結するフラグ
    
    ' 範囲を取得
    intRowS = Selection(1).row
    intRowE = Selection(Selection.Count).row
    intColS = Selection(1).Column
    intColE = Selection(Selection.Count).Column

    strResult = ""

    ' 範囲をループ
    For intRow = intRowS To intRowE
        For intCol = intColS To intColE
            Dim rngCrnt As Range    ' 処理カレントセル
            Dim rngCrntMerge As Range   ' 処理カレントセル(セル結合を考慮)

            ' セル区切り
            strResult = strResult & "|"
            
            ' フラグクリア
            blMargeUpRow = False
            blMargeRightCol = False
            
            ' カレントセル取得
            Set rngCrnt = Cells(intRow, intCol)
            Set rngCrntMerge = rngCrnt.MergeArea
            
            ' 結合セルの場合
            If rngCrnt.MergeCells Then
                
                ' 1つ前の行のセルも一緒に結合されている場合
                If intRow > intRowS Then
                    If Cells(intRow - 1, intCol).MergeArea.Address = rngCrntMerge.Address Then
                        blMargeUpRow = True
                    End If
                End If
                
                ' 1つ前の行のセルへ結合
                If blMargeUpRow Then
                    strResult = strResult & "~"
                Else
                    ' 1つ右の列のセルも一緒に結合されている場合
                    If intCol < intColE Then
                        If Cells(intRow, intCol + 1).MergeArea.Address = rngCrntMerge.Address Then
                            blMargeRightCol = True
                        End If
                    End If
                    
                    ' 1つ右の列のセルへ結合
                    If blMargeRightCol Then
                        strResult = strResult & ">"

                    ' 結合セルの一番右上のセルの場合
                    Else
                        ' セル情報
                        strResult = strResult & GetCellInfoStr(rngCrntMerge, blWithFormat)
                    End If
                End If
            
            ' 単独セルの場合
            Else
                ' セル情報
                strResult = strResult & GetCellInfoStr(rngCrntMerge, blWithFormat)
            End If
        Next
        
        ' 行終端のセル区切り
        strResult = strResult & "|" & vbCrLf
    Next
    
    ' 戻り値
    ConvertPukiWiki = strResult

End Function

Private Function GetCellInfoStr( _
    ByRef rngCrnt As Range, _
    ByVal blWithFormat As Boolean _
) As String

    Dim strResult As String ' セル情報文字列
    
    ' 書式あり
    If blWithFormat Then
        ' セル情報
        strResult = GetCellAlignmentStr(rngCrnt) & _
                    GetCellForeColorStr(rngCrnt) & _
                    GetCellBackColorStr(rngCrnt) & _
                    GetCellValueStr(rngCrnt)
    ' 書式なし
    Else
        ' セル情報
        strResult = GetCellValueStr(rngCrnt)
    End If
    
    ' 戻り値
    GetCellInfoStr = strResult

End Function

Private Function GetCellAlignmentStr( _
    ByRef rngCrnt As Range _
) As String

    Dim strResult As String ' アライメント文字列
    
    ' セルの水平アライメントで分岐
    Select Case rngCrnt.HorizontalAlignment
    ' 初期状態
    Case xlGeneral
        strResult = ""
    ' 左
    Case xlLeft
        strResult = ""
    ' 中央
    Case xlCenter
        strResult = "CENTER:"
    ' 右
    Case xlRight
        strResult = "RIGHT:"
    End Select
    
    ' 戻り値
    GetCellAlignmentStr = strResult

End Function

Private Function GetCellForeColorStr( _
    ByRef rngCrnt As Range _
) As String

    Dim strResult As String ' 前景色文字列
    
    ' セルの前景色をRGB文字列として取得
    If Not IsNull(rngCrnt.Font.Color) Then
        strResult = "COLOR(#" & GetRGBStr(rngCrnt.Font.Color) & "):"
    End If
    
    ' 前景色:黒の場合は削除
    If strResult = "COLOR(#000000):" Then
        strResult = ""
    End If
    
    ' 戻り値
    GetCellForeColorStr = strResult

End Function

Private Function GetCellBackColorStr( _
    ByRef rngCrnt As Range _
) As String

    Dim strResult As String ' 背景色文字列
    
    ' セルの背景色をRGB文字列として取得
    If Not IsNull(rngCrnt.Interior.Color) Then
        strResult = "BGCOLOR(#" & GetRGBStr(rngCrnt.Interior.Color) & "):"
    End If

    ' 背景色パターンが純色以外は削除
    If rngCrnt.Interior.Pattern <> xlSolid Then
        strResult = ""
    End If
    
    ' 戻り値
    GetCellBackColorStr = strResult

End Function

Private Function GetRGBStr( _
    ByVal lngColor As Long _
) As String

    Dim strRGB As String    ' RGB文字列
    Dim strHex As String    ' 16進文字列

    ' 16進文字列に変換
    strHex = Hex(lngColor)
    
    ' 0パディングして8桁にする
    strHex = String(8 - Len(strHex), "0") & strHex
    
    ' R値を取り出す(7,8文字目)
    strRGB = Mid(strHex, 7, 2)
    ' G値を取り出す(5,6文字目)
    strRGB = strRGB & Mid(strHex, 5, 2)
    ' B値を取り出す(3,4文字目)
    strRGB = strRGB & Mid(strHex, 3, 2)
    
    ' 戻り値
    GetRGBStr = strRGB

End Function

Private Function GetCellValueStr( _
    ByRef rngCrnt As Range _
) As String

    Dim strResult As String ' セルの値文字列
    
    ' セルの値を取得
    strResult = rngCrnt(1, 1).Value
    
    ' セル内改行を変換
    strResult = Replace(strResult, vbLf, "&br;")

    ' 特殊文字を数値参照文字に変換
    strResult = Replace(strResult, "|", "&#x7c;") ' |
'    strResult = Replace(strResult, " ", "&#x20;") ' 半角SPは意味無い?

    ' 戻り値
    GetCellValueStr = strResult

End Function
}}

トップ   編集 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS