開発Tips/PukiWiki

  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
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234

' *****************************************
' 選択範囲のセルから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