指定した文字列のフォントを狙い撃ちで変えるマクロ[Word]

Wordで指定した文字列だけ狙い撃ちでフォントを変えるマクロ

文字列単位でフォントを変える

1文字単位でフォントを変える、というのは過去にやったことがあるが、それだと巻き添えで関係のないところまでフォントが変わってしまうので、ちょっとメンドクサかった。

たとえば、音階を表すカタカナの「ラ」だけをゴシックにしたかったとして、「ラはファラオのラ~♪」という文字列に対して処理をすると、巻き添えで「ファラオ」の「ラ」までゴシックになってしまう、ということだ。

f:id:akashi_keirin:20180121194442j:plain

まあ、完全に巻き添え事故を防ぐことは難しいにせよ、文字列単位でフォントを変える、ということができれば、かなり減らすことはできると考えた。

考え方

ただ、文字列全体から任意の文字列を切り出すだけなら Mid関数 を使えば楽勝だが、悲しいことにフォントを変えるためにはFontオブジェクトにアクセスせねばならず、文字列を切り出しても仕方がない。

で、次のように考えた。

  1. まず、文字列全体をCharactersコレクションとして取得する。
  2. x 番目のCharacterオブジェクトから、比較対象文字列(フォントを変えたい文字列)の文字数分だけ切り出して、文字列を作る。
  3. 2.で作成した文字列を比較対象文字列と比較する。
  4. 3.の結果が同じであれば、 x 番目のCharacterオブジェクトから、 x + (比較対象文字列の文字数) - 1 番目のCharacterオブジェクトまでのFont.Nameプロパティを変更したいフォント名にする。
  5. 2.~4.を文字列全体の字数 - 比較対象文字列の字数 + 1 回繰り返す。

このように考えた。

コーディング

上記の考えに基づいて以下のコードを書いた。

リスト1ー1 標準モジュール
Public Function applyFontType(ByVal targetSentences As Word.Characters, _
                              ByVal compareTo As String, _
                              ByVal nameOfFont As String) As Boolean
  Dim maxCount As Integer
  maxCount = targetSentences.Count
  Dim wordCount As Integer
  wordCount = Len(compareTo)
  Dim i As Integer
  Dim str As String
  For i = 1 To maxCount - wordCount + 1
    str = assembleWordFromChar(targetSentences:=targetSentences, _
                               extractFrom:=i, _
                               extractTo:=i + wordCount - 1)
    If str = compareTo Then
      Call applyFont(targetSentences:=targetSentences, _
                     startFrom:=i, _
                     endAt:=i + wordCount - 1, _
                     nameOfFont:=nameOfFont)
    End If
  Next
  applyFontType = True
End Function

引数に文字列全体、比較対象文字列、変更したいフォント名を与えると、比較対象文字列の部分のフォントを変え、処理が無事に終わったらTrueを返すFunctionにしている。

リスト1ー2 標準モジュール
Private Function assembleWordFromChar(ByVal targetSentences As Word.Characters, _
                                      ByVal extractFrom As Integer, _
                                      ByVal extractTo As Integer) As String
  Dim i As Integer
  Dim str As String
  For i = extractFrom To extractTo
    str = str & targetSentences(i)
  Next
  assembleWordFromChar = str
End Function

こいつは、指定された字数分の文字列をCharactersコレクションから作り出すFunction。

リスト1ー3 標準モジュール
Private Sub applyFont(ByVal targetSentences As Word.Characters, _
                      ByVal startFrom As Integer, _
                      ByVal endAt As Integer, _
                      ByVal nameOfFont As String)
  Dim i As Integer
  For i = startFrom To endAt
    targetSentences(i).Font.Name = nameOfFont
  Next
End Sub

んで、こいつが、Charactersコレクションの指定された範囲のFont.Nameプロパティを変更するSub。

ほとんどコイツをそのままコードに置き換えただけ。

実験

次のコードで実行した。

スト2 標準モジュール
Public Sub testApplyFontType()
  Dim ar As Variant
  ar = Array("ち~んw", "プヒー!", "(゚Д゚)ハァ?")
  Dim i As Integer
  For i = 0 To 2
    If Not applyFontType(targetSentences:=Selection.Characters, _
                         compareTo:=ar(i), _
                         nameOfFont:="MS ゴシック") Then
      Call makeUserSick("失敗www")
      Exit Sub
    End If
  Next
End Sub

短いコードなので、見たら分かると思うが、配列変数 ar に、「ち~んw」、「プヒー!」、「(゚Д゚)ハァ?」の3つの文字列を持たせて、それをForループで回してapplyFontTypeの引数として渡して実行している。

第1引数には、

Selection.Characters

を指定しているので、文書上の選択した範囲の文字列のうち、「ち~んw」、「プヒー!」、「(゚Д゚)ハァ?」となっている部分のフォントが「MS ゴシック」になるということだ。

f:id:akashi_keirin:20180121194454j:plain

ドキュメント上にこんな文章を用意して、

f:id:akashi_keirin:20180121194502j:plain

こんなふうに文字列を選択した状態で実行すると、

f:id:akashi_keirin:20180121194512j:plain

ほれ、この通り。

狙い通りの結果になっている。

おわりに

実行にえらく時間がかかるので、たぶんあんまり良くないやり方なんだろうなあ……。

@akashi_keirin on Twitter

フォントが存在するかどうかを判定するFunction [Word]

指定したフォントの存否を調べるFunction

指定したフォントが存在するかどうかをどうやって調べるのか

だいぶ前に、超有名なOffice TANAKA さんのサイトで、

フォントの一覧を取得するマクロ

というものを見たことがあった。

んで、単純にこれをWordに移植できないものか、やってみたら……。

f:id:akashi_keirin:20180121174228j:plain

「実行時エラー438」というエラーが吐かれる。

どうも、Wordのフォント選択コンボボックスは、Excelとは指定の仕方が異なる模様。でもこんなの、どうやって調べたらいいんだろう……。

ちょっと素人の私には手がでないので、別の方法を考えた。

Excelを呼んで強引に解決する

題名の通りの力業ですw

VBEの「ツール」→「参照設定」から、「Microsoft Excel 1x.x Object Library」にチェックを入れておきましょう。

リスト1 標準モジュール
Public Function hasFont(ByVal nameOf As String) As Boolean
  Dim xlApp As New Excel.Application    '……(1)'
  xlApp.Visible = False
  Dim xlBook As Excel.Workbook    '……(2)'
  Set xlBook = xlApp.Workbooks.Add
  Dim i As Integer
  With xlApp.CommandBars("Formatting").Controls(1)    '……(3)'
    For i = 1 To .ListCount    '……(4)'
      If nameOf = .List(i) Then hasFont = True: Exit For    '……(5)'
      If i = .ListCount Then hasFont = False    '……(6)'
    Next
  End With
  xlBook.Close False    '……(7)'
  xlApp.Quit
  Set xlBook = Nothing
  Set xlApp = Nothing
End Function

まず、(1)の

Dim xlApp As New Excel.Application

で、Excel.Applicationのインスタンスを生成。

(2)からの2行

Dim xlBook As Excel.Workbook
Set xlBook = xlApp.Workbooks.Add

で新規ブックを作成し、変数xlBookにぶち込む。

これをすることによって、画面にExcelのブックが表示されてしまう。うっとうしいんだけれど、これをしないと、

f:id:akashi_keirin:20180121174322j:plain

こんなふうに、ListCountメソッドが失敗してしまう。

ちなみに、このときに、イミディエイトで

xlApp.Visible = True

としてExcelを表示させてみると、

f:id:akashi_keirin:20180121174332j:plain

このようになっていて、フォント選択のコンボボックスは死んでいる……というかまだ生まれていないみたい。

(3)からの6行

With xlApp.CommandBars("Formatting").Controls(1)
  For i = 1 To .ListCount    '……(4)'
    If nameOf = .List(i) Then hasFont = True: Exit For    '……(5)'
    If i = .ListCount Then hasFont = False    '……(6)'
  Next
End With

ExcelのCommandbars("Formatting").Controls(1)オブジェクトのListプロパティを参照して、引数nameOfで渡したフォント名と比較する。

(4)の

For i = 1 To .ListCount

では、Forループの終了値をListCountプロパティの値にしている。ちなみに、Intellisenceは働かないので、そのつもりで。

(5)の

If nameOf = .List(i) Then hasFont = True: Exit For

では、引数nameOfで渡されたフォント名と、Listプロパティで得られたフォント名を比較し、一致すればTrueをreturnしてForループから抜けるようにしている。

(6)の

If i = .ListCount Then hasFont = False

では、 i がListCountプロパティの値になってここにたどり着くということは、一致するフォント名がなかった、ということなので、Falseをreturnすることにしている。

Forループを抜けた時点で、このFunctionがreturnする値は決まっているので、(7)からの4行

xlBook.Close False
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing

で終了処理。

使ってみる

次のコードで実験。

スト2 標準モジュール
Public Sub testHasFont()
  Debug.Print hasFont("ち~んw")    '……(1)'
  Debug.Print hasFont("MS ゴシック")    '……(2)'
End Sub

(1)では、存在するはずのないフォント名「ち~んw」を、(2)では確実に存在する「MS ゴシック」を引数として渡して、結果をイミディエイトに出力させてみた。

当然、False、Trueの順で表示されるはずだ。

実行結果

f:id:akashi_keirin:20180121174344j:plain

見込み通りの結果となった。

おわりに

でも、絶対にWordだけでもできるはずだよなあ……。

@akashi_keirin on Twitter

Excel VBA を使ってグラフを描く

素人、グラフに挑戦する

ExcelVBAでグラフを描く

実は、今までほとんどExcelでグラフを使ったことがなかったのである。

まったくグラフを使うことがなかったわけではないが、ずーっと前に誰かが作ったグラフをちょこちょこっといじくる程度で乗りきっていたのである。

ところが、なぜか職場では Excelができる人認定されている私は、

Excelができる=グラフもバリバリ

という魔の方程式のせいで、

アンタ、Excel得意やからグラフを用いたデータ分析なんかもチョチョイのチョイやろ?

と、やけに軽々しく

データ分析&見栄え良く加工する業務

を割り当てられたのであった(´・ω・`)

グラフの種類を概観するマクロ

ずーっと前に、『Excel VBAでデータ分析』(川上恭子著)という本を購入していたのを思い出して引っ張り出してみた。

f:id:akashi_keirin:20180121153659j:plain

その本によると、

118ページ

新しくグラフシートを追加して、そのシートにグラフだけを表示します。

ソースコード
Sub グラフシートに作成()
'グラフシートにマーカー付折れ線グラフを作成'
    With Charts.Add
        .ChartType = xlLineMarkers
        .SetSourceData Source:=Sheets("Sheet1").Range("A3:G8")
    End With
End Sub

とあった。

ぱっと見た感じ、単にグラフを描くだけなら、

  1. ChartsコレクションにAddしたら、(たぶん)新しいChartオブジェクトが得られ、
  2. 1.で得られたChartオブジェクトのChartTypeプロパティにグラフの種類をセットして、
  3. SetDataSourceメソッドでグラフ化する元データを指定する

という流れだけっぽい。

とりあえずこれだけなら素人の私にもできそうだ。

前掲書の119ページには、

グラフの種類

ChartTypeプロパティに設定する定数を以下のように指定すると、グラフの種類を変更できます。また定数には値を指定することもできます。

ChartTypeプロパティ
グラフ 定数
集合縦棒 xlColumnClustered 51
積み上げ縦棒 xlColumnStacked 52
100%積み上げ縦棒 xlColumnStacked100 53
3-D集合縦棒 xl3DColumnClustered 54
3-D積み上げ縦棒 xl3DColumnStacked 55
3-D100%積み上げ縦棒 xl3DColumnStacked100 56
3-D縦棒 xl3DColumn -4100
集合横棒 xlBarClustered 57
3-D集合横棒 xl3DBarClustered 60
折れ線 xlLine 4
マーカー付き折れ線 xlLineMarkers 65
xlPie 5
補助円グラフ付き円 xlPieOfPie 68
補助縦棒グラフ付き円 xlBarOfPie 71
3-D円 xl3 DPie -4102
ドーナツ xlDoughnut -4120
xlArea 1
積み上げ面 xlAreaStacked 76
3-D面 xl3DArea -4098
散布図 xlXYScatter -4169
バブル xlBubble 15
株価チャート(高値-安値-終値 xlStockHLC 88
レーダー xlRadar -4151
マーカー付きレーダー xlRadarMarkers 81

とあり、ChartTypeプロパティに渡す値を変えれば、同じデータからいろんなグラフが作れそうだ。

ちなみに、オブジェクトブラウザーで見てみると、

f:id:akashi_keirin:20180121152423j:plain

これらの定数は、「XLChartType列挙体」のメンバのようだ。【→参考

とりあえずやってみる

まずは、単純に、引数としてグラフの種類を表す定数と、グラフ化する元データの範囲を与えたら、新しいシートにサクッとグラフを作ってくれるマクロを作ってみる。

リスト1 標準モジュール
Public Function createGraph(ByVal typeOfGraph As String, _
                            ByVal sourceRange As Range) As Boolean
  If getGraphType(typeOfGraph) = 0 Then    '……(*)'
    createGraph = False
    Exit Function
  End If  
  With Charts.Add
    .ChartType = getGraphType(typeOfGraph)    '……(*)'
    .SetSourceData Source:=sourceRange
  End With
  createGraph = True
End Function

引数typeOfGraphがString型であること、あと(*)の

getGraphType(typeOfGraph)

がナゾだと思う。getGraphTypeというのは自作Functionなんだから仕方がない。

あと、なんでSubじゃなくてFunctionにしているのか、についても後述する。

引数でグラフの種類と元データの範囲を受け取って、それをもとにグラフを新規作成する、というだけのマクロ。もちろん、単独でこのプロシージャを呼び出しても動かない。次のgetGraphTypeが必要になる。

スト2 標準モジュール
Private Function getGraphType(ByVal typeOfGraph As String) As XlChartType
  Select Case typeOfGraph
    Case "集合縦棒"
      getGraphType = xlColumnClustered
    Case "積み上げ縦棒"
      getGraphType = xlColumnStacked
    Case "100%積み上げ縦棒"
      getGraphType = xlColumnStacked100
    Case "3-D集合縦棒"
      getGraphType = xl3DColumnClustered
    Case "3-D積み上げ縦棒"
      getGraphType = xl3DColumnStacked
    Case "3-D100%積み上げ縦棒"
      getGraphType = xl3DColumnStacked100
    Case "3-D縦棒"
      getGraphType = xl3DColumn
    Case "集合横棒"
      getGraphType = xlBarClustered
    Case "3-D集合横棒"
      getGraphType = xl3DBarClustered
    Case "折れ線"
      getGraphType = xlLine
    Case "マーカー付き折れ線"
      getGraphType = xlLineMarkers
    Case "円"
      getGraphType = xlPie
    Case "補助円グラフ付き円"
      getGraphType = xlPieOfPie
    Case "補助縦棒グラフ付き円"
      getGraphType = xlBarOfPie
    Case "3-D円"
      getGraphType = xl3DPie
    Case "ドーナツ"
      getGraphType = xlDoughnut
    Case "面"
      getGraphType = xlArea
    Case "積み上げ面"
      getGraphType = xlAreaStacked
    Case "3-D面"
      getGraphType = xl3DArea
    Case "散布図"
      getGraphType = xlXYScatter
    Case "バブル"
      getGraphType = xlBubble
    Case "株価チャート(高値-安値-終値)"
      getGraphType = xlStockHLC
    Case "レーダー"
      getGraphType = xlRadar
    Case "塗りつぶしレーダー"
      getGraphType = xlRadarFilled
    Case "マーカー付きレーダー"
      getGraphType = xlRadarMarkers
    Case Else    '……(*)'
      Call makeUserSick("すまん、そのグラフの種類には対応しとらんわwww")
      getGraphType = 0
  End Select
End Function

すっげータテ長ですまん。見たら分かると思うけど、グラフの種類名を引数として渡したら、その名前に応じた定数を返すようにした。

データの入力規則のリストに名前を登録しといたら、それを選ぶだけで良いようにしたのだ。

一見、コードを書くのが死ぬほどメンドクサそうに見えると思うけれど、返り値の型を「XLChartType型」にしているので、それほどでもなかった。

ただ、XLChartTypeのメンバ全てに対応するのはちょっと数が多すぎて嫌になるので、基本的には、前掲書の119ページの表に載っていたものだけに対応した(追加したのは「マーカー付きレーダー」だけです)。

その関係で、選から漏れたグラフの種類を指定された場合には、ユーザーを軽く煽ってから、「0」を返すことにした。

要するに、対応していないグラフの種類とか、間違った名前を指定されたら、リスト1

If typeOfGraph = 0 Then createGraph = False: Exit Function

の条件式がTrueになるので、返り値Falseを持って呼び出し元へ帰る、ということになる。

グラフを描いてみる

ワークシートを、

f:id:akashi_keirin:20180121152434j:plain

こんなふうに作っておく。

A2セルには、データの入力規則で、特定のグラフの種類名しか入力できないように指定しておく。

んで、C1:H6にグラフの元データを準備した。

いちいちVBEから呼び出すのもメンドウなので、呼び出し用のコマンドボタンも置いておく。

エントリポイントのコードは次の通り。

リスト3 標準モジュール
Public Sub testCreateGraph()
  Dim Sh As Worksheet
  Set Sh = ThisWorkbook.Worksheets("Main")
  With Sh
    If Not createGraph(typeOfGraph:=.Range("A2").Value, _
                       sourceRange:=.Range("C1:H6")) Then    '……(*)'
      Call makeUserSick("すまん、グラフ描けんかったわwww")
    End If
  End With
End Sub

グラフの種類の指定がおかしかったら、リスト1の先頭で撥ねられて、Falseを持って帰ってくるので、(*)のところで

Call makeUserSick("すまん、グラフ描けんかったわwww")

が実行される。

グラフの種類の指定が正しければ、createGraphの中身が実行されてグラフが追加されることになる。

実行結果

f:id:akashi_keirin:20180121152434j:plain

この状態で実行してみる。A2セルには、「集合縦棒」が入っている。

f:id:akashi_keirin:20180121152502j:plain

ほれ、このとおり。

f:id:akashi_keirin:20180121152520j:plain

A2セルには「折れ線」。

f:id:akashi_keirin:20180121152601j:plain

ほれ、このとおり。

f:id:akashi_keirin:20180121152614j:plain

A2セルには「マーカー付きレーダー」。

f:id:akashi_keirin:20180121152628j:plain

ほれ、このとおり。

A2セルには入力規則で制限を掛けているので、通常おかしなグラフの種類名が渡るはずはないが、ムリヤリリスト1の引数typeOfGraphにデタラメな文字列を与えてみると、

Public Sub testCreateGraph()
  Dim Sh As Worksheet
  Set Sh = ThisWorkbook.Worksheets("Main")
  With Sh
    If Not createGraph(typeOfGraph:="ち~んw", _    '……(*)'
                       sourceRange:=.Range("C1:H6")) Then
      Call makeUserSick("すまん、グラフ描けんかったわwww")
    End If
  End With
End Sub

f:id:akashi_keirin:20180121152639j:plain

f:id:akashi_keirin:20180121152651j:plain

無事、グラフが作成されずに、煽られるだけ、となりますw

おわりに

現状、ボタンを押したらいきなり新規シートにグラフを作成する、という乱暴なものになっている。

Chartオブジェクト関係のオブジェクトモデルをもっとちゃんと理解して、もう少し使い勝手の良いものにしないといけないなあ。

範囲内の文字列を配列化するFunction

範囲内の各セルの値(文字列)を配列化するFunction

範囲内の文字列の配列化

この間、

特定の文字列のみ狙い撃ちでゴシック体にする

みたいなくそめんどくさい作業に遭遇した。

もちろん、ちゃちゃっとコード書いて瞬殺したんですが、そのときに、

対象の文字なり文字列なりをワークシートに表で作っておいて、Functionで配列化できたら便利なんじゃね?

と思っただけです。

コーディング

次のようなFunctionを作った。

リスト1 標準モジュール
Public Function getValueArray(ByVal targetRange As Range) _
                                    As String()    '……(1)'
  Dim countOfCells As Integer
  countOfCells = targetRange.Count    '……(2)'
  Dim tmpArray() As String    '……(3)'
  ReDim tmpArray(countOfCells - 1)
  Dim n As Integer
  Dim targetCell As Range
  For Each targetCell In targetRange    '……(4)'
    tmpArray(n) = targetCell.Value
    n = n + 1
  Next
  getValueArray = tmpArray    '……(5)'
End Function

まず、(1)の

Public Function getValueArray(ByVal targetRange As Range) As String()

でFunctionの名前と引数、返り値の型を指定。

引数としてセル範囲を与えると、String型の配列を返すFunctionにしている。

(2)の

countOfCells = targetRange.Count

では、引数で渡されたRangeオブジェクト(targetRange)に含まれるセルの個数をCountプロパティを参照して獲得し、変数countOfCellsにぶち込んでいる。

(3)からの2行

Dim tmpArray() As String
ReDim tmpArray(countOfCells - 1)

では、String型の配列変数tmpArray()をとりあえず宣言しておき、すかさずReDim。配列の添え字の最大数は、要素数-1なので、「countOfCells - 1」になる。

(4)からの4行

For Each targetCell In targetRange
  tmpArray(n) = targetCell.Value
  n = n + 1
Next

では、「For Each ~ Next」を使って引数で渡された範囲の各セルを巡回し、それぞれの値を配列変数tmpArrayにぶち込んでいく。通常の「For ~ Next」と違って、ブロック内で n をインクリメントしておかないとアホな結果になるので注意。

あとは、(5)の

getValueArray = tmpArray

で配列tmpArrayを返り値としてreturnしてやればおk。

使ってみる

f:id:akashi_keirin:20180120094626j:plain

こんなふうに範囲を選択して、次のコードで使ってみる。

スト2 標準モジュール
Public Sub getValueArrayTest()
  Dim ar() As String
  ar = getValueArray(Selection)    '……(1)'
  Dim i As Integer
  For i = 0 To UBound(ar)    '……(2)'
    If ar(i) = "" Then ar(i) = "*"
    Debug.Print ar(i)
  Next
End Sub

(1)の

ar = getValueArray(Selection)

は、getValueArrayに引数として「Selection」(選択中のセル範囲)を渡し、返り値を配列変数 ar にぶち込む、という意味。配列用の変数名がなげやりですまんw

あとは、(2)からの4行

For i = 0 To UBound(ar)
  If ar(i) = "" Then ar(i) = "*"
  Debug.Print ar(i)
Next

では、Forループを使って配列 ar の各要素を取り出してイミディエイトに表示するようにしている。UBoundはこういうときに欠かせない組み込み関数ですな。

一応、配列の要素が「""」(長さ0の文字列)だったら代わりに「*」を表示するようにした。

実行結果

f:id:akashi_keirin:20180120094635j:plain

このように、「*」が表示されているところを見ると、「For Each ~ Next」では、結合されたセルも一つ一ついわゆる「Zオーダー」で巡回する仕様になっているようだ。

おわりに

使いどころ、他にあるかいな……。あと、Zオーダー以外の順番にも対応する必要があるかも知れん。でもそうなると、Dictionaryでやる方が便利かなあと思ったり。

@akashi_keirin on Twitter

「"」(ダブルクォーテーション)のエスケープ

「"」(ダブルクォーテーション)のエスケープ

恥ずかしい告白

まことに今さらながら、実は、

「"」(ダブルクォーテーション)のエスケープについて、ちゃんと理解していなかった

のである!

では、どうしていたのかというと、

そのときどきでテキトーに書いて、望む実行結果が得られるまで試行錯誤

という、

実に恥ずかしいやり方

をしていたのである!

勉強した

そこで、有名な Office TANAKA さんのサイトで勉強した。

むかーし、それこそVBAに手を染め始めた頃にも見たような気がするが、改めて見るとすっげー分かりやすく説明されていた。

曰く、

まず大原則として文字列はダブルコーテーション(")で囲む必要があります。つまり、文字列の両端は必ずダブルコーテーション(")でなければならないのです。この両端の「"」は、実際には表示されず、内側にあるのが文字列だということを示す特別な記号です。

次に、ダブルコーテーション(")を単なるの記号(文字列)として使いたいときは、
(……中略……)
「""」と2つ続けて書きます。文字列の内部でダブルコーテーション(")が2つ続いた場合には、特別な記号ではなく、「"」を単なる記号として認識してくれるのです。いわば、最初の「"」は、後の「"」に対するエスケープ文字的な働きをします。

なんと、こんなに簡単なことだったのだ!!!!!!!!

自分なりに整理すると、「"」を単なる文字列としてVBAに認識させたいときは、

  1. まず全体を「""」で括り、
  2. 文字として扱いたい「"」が出てくるごとに「"(エスケープ)"(ダブルクォーテーション)」と心の中で唱えながら入力する
    ※カッコ内は心の中の声

という手順でやれば良いわけだ。

たとえば、「"ち~んw"」とダブルクォーテーション付きで認識させたい場合は、

f:id:akashi_keirin:20180120084641j:plain

こんな風に入力することになる。

心の中で

  1. まず両サイドを「""」で括り(赤で表示した「"」)、
  2. エスケープ用の「"」(緑)と表示用の「"」(黄)を入力して、
  3. 「ち~んw」と入力して、
  4. エスケープ用の「"」と表示用の「"」を入力する、っと……。

このように唱えながら作業する癖をつけたら良いわけだ。

前回

akashi-keirin.hatenablog.com

でやったみたいに、

<td colspan=""></td>

とか、

<td rowspan="1"></td>

みたいな文字列を作りたいときは、

f:id:akashi_keirin:20180120084651j:plain

f:id:akashi_keirin:20180120084703j:plain

こんなふうにしたら良い。

練習

次のコードでやってみる。

リスト1 標準モジュール
Public Sub escapeTest()
  Debug.Print """ち~んw"""
  Debug.Print "<td colspan=""""></td>"
  Debug.Print "<td rowspan=""1""></td>"
End Sub

f:id:akashi_keirin:20180120084715j:plain

これを実行すると、

f:id:akashi_keirin:20180120084726j:plain

ほれ、うまくいった。

おわりに

やっぱり、基本は大切です。

@akashi_keirin on Twitter

HTMLのtable要素を作るFunction(2)

HTMLのtable要素を作成するマクロの改良

前回の

akashi-keirin.hatenablog.com

こいつを改良してみた。

行・列結合への対応

HTMLのtable要素で、行結合とか列結合をする場合は、タグとかタグの中に、それぞれ「rowspan="2"」とか、「colspan="3"」などと書き込むだけで良いので、そんなに難しくないのではないか、と思った。

確認

まず、Excelのシート上に

f:id:akashi_keirin:20180114204722j:plain

こんな表を作ってみた。

んで、次のようなコードを書いて、それぞれのセルの値がどのように取得されるのか確認してみた。

リスト1 標準モジュール
Public Sub testMethod(targetRange As Range)
  Dim Sh As Worksheet
  Set Sh = targetRange.Parent
  Dim startRow As Integer
  Dim startColumn As Integer
  Dim endRow As Integer
  Dim endColumn As Integer
  With targetRange
    With .Cells(1, 1)
      startRow = .Row
      startColumn = .Column
    End With
    endRow = startRow + .Rows.Count - 1
    endColumn = startColumn + .Columns.Count - 1
  End With
  Dim i As Integer
  Dim j As Integer
  Dim str As String
  Dim tmp As String
  For i = startRow To endRow
    str = ""
    For j = startColumn To endColumn
      With Sh.Cells(i, j)    '……(1)'
        If .Value = "" Then    '……(2)'
          tmp = "*"
        Else
          tmp = .Value
        End If
        If j <> endColumn Then    '……(3)'
          str = str & tmp & " | "
        Else
          str = str & tmp
        End If
      End With
    Next
    Debug.Print str    '……(4)'
  Next
End Sub

えらくタテ長になってしまった。

簡単なコードなので、説明は最小限にとどめる。

(1)からの6行

With Sh.Cells(i, j)    '……(1)'
  If .Value = "" Then    '……(2)'
    tmp = "*"
  Else
    tmp = .Value
  End If
'……(中略)……'
End With

では、対象の表の各セルの値について調べ、(2)の

If .Value = "" Then
  tmp = "*"
Else
  tmp = .Value
End If

で、値がなかったら変数tmpに「*」をぶち込み、値が入っていたら変数tmpにその値をぶち込むようにしている。

(3)の

If j <> endColumn Then
  str = str & tmp & " | "
Else
  str = str & tmp
End If

では、最終列に到達するまでは、変数strにtmpの値と「 | 」を付け加え、最終列に到達したときだけ「 | 」を付け加えないようにしている。まあ、ここは、別に最後に右端の「 | 」を取り除くような処理でも良いと思う。

内側のForループ(イテレータが j の方)を抜けたら、1行分完成ということなので、(4)の

Debug.Print str

でstrの内容、すなわち1行分の要素をイミディエイトに書き出す。

ちなみに、strの内容は、外側のForループ先頭で""に初期化される。

こいつを実行してみる。

f:id:akashi_keirin:20180114204730j:plain

これを見ると、「b」の下2つと「o」の右1つが「*」になっていることが分かる。

つまり、結合されたセルに含まれるセルの値を参照すると、TopLeftのセル以外は全て「""」を返しているということだ。

んで、結合されたセルをアクティブにして、イミディエイトでいくつか確認してみる。

f:id:akashi_keirin:20180114204838j:plain

?activecell.MergeArea.Columns.Count
1
?activecell.MergeArea.Rows.Count
3
?activecell.MergeCells
True
?activecell.MergeArea.Count
3

要するに、

  • MergeCellsプロパティがTrueで、Valueが""でないセルに当たったら、
  • rowspanを「="[MergeArea.Rows.Countプロパティの値]"」にして、
  • colspanを「="[MergeArea.Columns.Countプロパティの値]"」にし、
  • MergeCellsプロパティがTrueで、Valueが""のセルに当たったら、
  • rowspanとcolspanを「=""」にしたらよい

ということだ。

ちょいと条件が複雑だけれど、まあ簡単な方だと思う。

コードの改変

前回のリスト1を改変する。

スト2 標準モジュール
Public Function createHTMLTable( _
                  ByVal targetRange As Range, _
                  ByVal captionText As String, _
                  Optional ByVal hasHeader As Boolean = True, _
                  Optional ByVal hasBorder As Boolean) _
                    As String
  Dim rowCount As Long
  rowCount = targetRange.Rows.Count
  Dim columnCount As Long
  columnCount = targetRange.Columns.Count
  Dim i As Long
  Dim j As Long
  Dim stringOfCell() As String
  ReDim stringOfCell(0 To rowCount - 1, 0 To columnCount - 1)
  For i = 0 To rowCount - 1
    For j = 0 To columnCount - 1
      stringOfCell(i, j) = targetRange.Cells(i + 1, j + 1).Value
    Next
  Next
  Dim str As String
  Dim rowSpan As String
  Dim colSpan As String
  If hasBorder Then
    str = "<table border=""1"">"
  Else
    str = "<table border="""">"
  End If
  If Not IsMissing(captionText) Then _
    str = str & "<caption>" & captionText & "</caption>"
  For i = 1 To rowCount
    str = str & "<tr>"
    For j = 1 To columnCount
      With targetRange.Cells(i, j)                       '……(1)'
        If stringOfCell(i - 1, j - 1) <> "" And _
           .MergeCells Then                              '……(2)'
          rowSpan = CStr(.MergeArea.Rows.Count)          '……(3)'
          colSpan = CStr(.MergeArea.Columns.Count)
        Else
          rowSpan = ""                                   '……(4)'
          colSpan = ""
        End If
      End With
      If hasHeader And i = 1 Then
        str = str & "<th rowspan=""" & rowSpan & _
                       """ colspan=""" & colSpan & """>" & _
                       stringOfCell(i - 1, j - 1) & "</th>"    '……(5)'
      Else
        str = str & "<td rowspan=""" & rowSpan & _
                       """ colspan=""" & colSpan & """>" & _
                       stringOfCell(i - 1, j - 1) & "</td>"
      End If
    Next
    str = str & "</tr>"
  Next
  str = str & "</table>"
  str = Replace(str, " rowspan=""""", "")          '……(6)'
  str = Replace(str, " rowspan=""1""", "")
  str = Replace(str, " colspan=""""", "")
  str = Replace(str, " colspan=""1""", "")
  str = Replace(str, "<th></th>", "")
  str = Replace(str, "<td></td>", "")
  str = Replace(str, vbLf, "<br>")
  createHTMLTable = str
End Function

後から機能を追加するような形になったので、ややこしくなってしまったことは堪忍してほしい。

またヒマなときにリファクタリングは必要だと思っている。

まず、(1)からの10行(実質9行)

With targetRange.Cells(i, j)
  If stringOfCell(i - 1, j - 1) <> "" And _
    .MergeCells Then                              '……(2)'
    rowSpan = CStr(.MergeArea.Rows.Count)          '……(3)'
    colSpan = CStr(.MergeArea.Columns.Count)
  Else
    rowSpan = ""                                   '……(4)'
    colSpan = ""
  End If
End With

では、そのセルが結合されているかどうかを調べ、さらにそのセルが値を持っていたら(つまり結合セルのTopLeftだったら)変数rowSpanとcolSpanに設定すべき値をぶち込み、値を持っていなかったら変数rowSpanとcolSpanに「""」をぶち込んでいる。

(2)の

If stringOfCell(i - 1, j - 1) <> "" And _
  .MergeCells Then

の条件式がTrueになるのは、

結合されたセルであり、かつ値を持っている場合

なので、(3)の

rowSpan = CStr(.MergeArea.Rows.Count)
colSpan = CStr(.MergeArea.Columns.Count)

で変数rowSpanとcolSpanに値をString型に変換してぶち込んでおく。

それ以外の場合(条件式がFalseになる場合)は、(4)の

rowSpan = ""
colSpan = ""

で変数の値を「""」にしておく。

これで、たとえば

2行3列の結合セルのTopLeft(左上)のセル

に行き当たった場合は、

<td rowspan="2" colspan="3">hogehoge</td>

となれば良いし、TopLeftのセル以外ならば

<td rowspan="" colspan="">fugafuga</td>

となれば良いわけだ。

そのために、たとえば(5)の

str = str & "<th rowspan=""" & rowSpan & _
            """ colspan=""" & colSpan & """>" & _
            stringOfCell(i - 1, j - 1) & "</th>"

のような形で文字列を組み立てる。「"(ダブルクォーテーション)」のエスケープがあるのでちょっと分かりづらいな。

あとは(6)からの5行で仕上げ。

str = Replace(str, " rowspan=""""", "")
str = Replace(str, " colspan=""""", "")
str = Replace(str, "<th></th>", "")        '……(*)'
str = Replace(str, "<td></td>", "")
str = Replace(str, vbLf, "<br>")

Replace関数を用いて、不要な文字列を削除する。

「rowspan=""」とか「colspan=""」はなくても良いわけだから、削除する。あったらむやみやたらと長くなるし。

(*)からの2行

str = Replace(str, "<th></th>", "")
str = Replace(str, "<td></td>", "")

では、「<th></th>」と「<td></td>」を削除している。

これをしないと、

f:id:akashi_keirin:20180114204740j:plain

こんなふうになってしまう(理由は自分で考えよう!)。

最後にセル内改行を「<br>」に置き換えるのは前回同様。

実行結果

次のコードで実行。

リスト3
Public Sub testHTMLTable()
  Dim Sh As Worksheet
  Set Sh = ThisWorkbook.Worksheets("Sheet2")
  Debug.Print createHTMLTable(targetRange:=Sh.Range("A9").CurrentRegion, _
                              captionText:="ち~んw", _
                              hasHeader:=True, _
                              hasBorder:=True)
End Sub

イミディエイトに出力された文字列をHTMLソースに貼り付けて、ブラウザで開くと、

f:id:akashi_keirin:20180114204904j:plain

ほれ、この通り、うまく行った。

もうちょっとややこしい表でも実験。

f:id:akashi_keirin:20180114204914j:plain
しまった……。「常荷金」だよ……。

こんな表を作って、同じように実行してみた。

f:id:akashi_keirin:20180114204922j:plain

こんな風になります。

おわりに

何やってんだろ、オレ……orz

@akashi_keirin on Twitter

モジュール名と同名のプロシージャ

「モジュール」とは何なのか?

「Module1」プロシージャ問題

つらつらとTwitterを眺めていると、フォローしている方が

モジュール名とプロシージャ名を同じにしてCallで呼ぼうとするとエラーが出ます。
(中略)
「モジュールではなく、変数またはプロシージャ名を指定してください。」というコンパイルエラーが出ます。

とツイートしていた。

このとき

akashi-keirin.hatenablog.com



Private指定したFunctionはイミディエイトで呼び出せなくて不便だよな

みたいにボヤいたら、ExcelVBAer (id:x1xy2xyz3)さんから、

?Module1.hogeHoge(foo, bar)

みたいに書いたらPrivateでもイミディエイトで呼び出せるぜ!

とアドヴァイスをいただいたのを思い出して、

Call Module1.Module1

って書いたら呼び出せるんじゃね?

などと、テキトーなことをぶっこいたら、

できた!

とのこと。

まぐれ当たりにもほどがある。

まあ、この際だから、いろいろ実験しておこうと思った。

実験 その1

まず、Module1にModule1というプロシージャを置く。

f:id:akashi_keirin:20180113131016j:plain

いちおうコードも載っけとこう。

リスト1 標準モジュール
Public Sub Module1()
  Call makeUserSick("呼んだ?")
End Sub

おなじみ、makeUserSickメソッドを呼び出しているだけw

このModule1プロシージャを、他の標準モジュールに次のコードを書いて呼び出すことを試みる。

スト2 標準モジュール
Public Sub callTest()
  Call Module1
End Sub

実行してみると……

f:id:akashi_keirin:20180113131028j:plain

あ、ホントだ。確かにコンパイルエラーになる。

そこで、リスト2 標準モジュール

Call Module1

の「Module1」のあとに「.」(ピリオド)を打ってみると、

f:id:akashi_keirin:20180113131045j:plain

このように、Intellisenceが働いて、「Module1」が選べるようになる。

リスト2を修正して次のようにする。

リスト3 標準モジュール
Public Sub callTest()
  Call Module1.Module1
End Sub

これで実行してみると、

f:id:akashi_keirin:20180113131101j:plain

ホントだ。ちゃんと実行できた。

実験 その2

ここでふと思った。

モジュールって"namespace"みたいなもんなんじゃね???

と。

そこで、別の標準モジュールに同じ「Module1」という名のプロシージャを置くことにした。

f:id:akashi_keirin:20180113131109j:plain

こんなふうに、「HTMLOperator」という名の標準モジュールに「Module1」というプロシージャを置く。

リスト4 標準モジュール
Public Sub Module1()
  Call makeUserSick("あら、また呼んだ?")
End Sub

んで、リスト3に次のようにコードを追加。

リスト5 標準モジュール
Public Sub callTest()
  Call Module1.Module1
  Call HTMLOperator.Module1
End Sub

コード入力中は、

f:id:akashi_keirin:20180113131119j:plain

こんなふうに、やはりIntellisenceが効く。

実行してみると……

f:id:akashi_keirin:20180113131128j:plain

f:id:akashi_keirin:20180113131138j:plain

普通に両方とも実行できた。

おわりに

まあ、同名のプロシージャが定義できたところで、あまり役に立ちそうな場面は思い浮かばない。結局いちいちモジュール名から指定しないといけないわけだから。

「namespace」というより「インスタンス化できないクラス」みたいなもんなのかなあ。

@akashi_keirin on Twitter