LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@Q11Q

WordVBA 現在の位置にフィールドコードで面積をコンマつき2位表示する 単位平方メートル、平方キロ、坪、アール、Ha、東京ドーム、ヤードポンド法

Last updated at Posted at 2020-10-24

前提

目的

  • 今回はマイナスについては考慮しない。
  • 坪を想定するように左から右へ書く日本語を想定。
  • 宅地の面積を平方メートル単位で入力すると、フィールドコードで換算して挿入される
  • フィールドコードのコードを表示すると元の入力した数値で、コードを非表示にして結果を表示すると、端数を四捨五入で処理した数字で検索できるようにする。
## 今回の特記仕様
  • 数字が足りない場合（たとえばコンマ付きで設定しているのに2桁しかない）ときは半角のスペースが「入らない」
  • これをクィックアクセスツールバーに登録すると、面積の数字を入力すると、単位がついてフィールドコードが挿入される。
  • エラーの場合はなにも起きない

数字が足りない場合のスペース

  • 例えばExcelの`#,##0`というのは整数位にコンマが表示される。しかしWordは`#`がそこに数字がない場合は半角スペースを挿入しろという意味になる。 http://www4.synapse.ne.jp/yone/word2010/word2010_field_sutisyo.html
  • このため整数位が0のときは0を表示させ、コンマつきにするのは`#,##0'でも可能だが、それでは半角スペースが入る。
  • また0を使うと必ず0が入る。
  • たとえば{ =0.01 ¥#"#,#00.##" }は’  00.01’と半角が2つ、ゼロが2つ入る。少なくとも#,#は半角に変わっている。00なのは0が2つだから。とりあえず半角が入るのは#が原因
  • { =0.01 ¥#"#,##0.##" }とすると、’   0.01’半角が3つになる。
#### Wordにおける正しいコンマつき表示形式 ¥#"#,0" このようにすると0のときは0。それ以上のときは指定された数が入る。ただし半角スペースが1つ入る。このため、問題になる場合もある。このような場合はVBAを用いて挿入するフィールドコードを分けても良い。 手順としては、換算を一度VBAでやり、Logで桁数を求めて3桁以下なら"0.00"に単位を続ける。

モジュールのプロシージャの一番上に、これを書く

Static Function LOG10(varDbl As Double) As Double
LOG10 = Log(var) / Log(10#)
End Function

フィールドコードを式に直す。エーカーを㎡に換算するとき、
"=INT((" & x & "*(1000/2471.0538146717))*100+0.5)/100"
これをvbaの式に変える
=Int((X*(1000/2471.0538146717))*100+0.5)/100
さらにLog10に代入する。必要なのは整数部なので、INTで切り捨てる。
Int(Log10(Int((X*(1000/2471.0538146717))*100+0.5)/100))
これで整数部の桁数は得られるので、あとは場合わけである。正負があればAbsが加わるが、前提として正の数としているので、考慮しない。

小数点以下について

  • 桁数を指定するのは0か#を使う
  • #は半角になってしまう
  • { =0.1 ¥#"#,##0.##" }は’   0.1; ’と0.1の後ろに必ず半角スペースが入る。
  • 00を指定すると0.10になり、宅地の面積としては好ましい
  • #、0いずれの場合でも必ず四捨五入される{ =0.005 ¥#"#,0.##" } と { =0.005 ¥#"#,0.00" }は0.01になる
  • { =0.004 ¥#"#,0.##" } は’ 0.0 ’と半角スペースが0の後ろに入り、 { =0.004 ¥#"#,0.00" }は’ 0.00’となる。

宅地の面積を平方メートル単位で表示するWordのフィールドコードの最適な書式

以上から
¥#"#,0.00"
となる。Excelとちょっと違ったものとなる。

差し込み印刷でもこの知識が必要

なぜかというと、ExcelからWordに流し込むときにExcelが「ごまかして」表示していた値ではなく、真の値が流れ込むためである。
つまり、二進法の近似十進計算の結果が差し込まれる。このため、「必ず」この表示形式の指定が必要である。

マクロの記録で入力すると、ちょっと違ったフィールドコードになるが、通常のフィールドコードの入力でも良い

マクロの記録

Selection.InsertFormula Formula:="=" & x , NumberFormat:="#,0.00'㎡'"
このように数字の表示形式であることが明示される

通常のフィールドコードの入力でも良い

Selection.InsertFormula Formula:="=" & x & " \#""#,0.00㎡"""

  Selection.InsertFormula Formula:="=" & x & " \#""#,0.00㎡"""

ただし、変数xのあとにフィールドコードと同様、半角の空白が必要

数字以外はアポストロフ（シングルクォーテーション）で囲む方がよい

そうしなくてもできるが、VBAの場合にはエラーになる。
またこのときダブルクォーテーションを二重にする
このため平方メートルを入れると
Selection.InsertFormula Formula:="=" & x , NumberFormat:="#,0.00㎡"
としても良いし
`Selection.InsertFormula Formula:="=" & x &" #""#,0.00'㎡'"""
両方ともいいのだが、面積をカッコ書きする場合など、数字の前に文字が来るとエラーになるのでアポストロフ（シングルクォテーション）で囲む方が良い。

キロ平方メートルはユニコードを使うか、Kmに上付数字を使うか。

上付き数字を使う場合のフィールドコード

    Selection.InsertFormula Formula:="=" & x & " / 10000", NumberFormat:="#,0.00'km'"
      Selection.MoveRight Unit:=wdCharacter, Count:=1
          Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.TypeText Text:="EQ \s \up(2)"
    Selection.Fields.ToggleShowCodes

これは平方kmに換算して表示する場合である。kmまではアルファベット、そしてSelection.MoveRight Unit:=wdCharacter, Count:=1で右に移動して、上付き数字を入力。しかしフィールドコードのままなので、最後にSelection.Fields.ToggleShowCodesで上付数字が表示される。
image.pngユニコードの単位だと
image.png
となる。
個人的には平方キロメートルは使っても立法キロメートルは使わないため2と3を間違えることはないので、ユニコード記号が良いような気がする。その一方で上付数字は見やすいしユニコードという不安もない。ただし上付き数字の場合は独立して1文字のため、行末で切れる恐れがある。また1文字としてカウントされる。とりあえずVBAでフィールドコードを挿入すると、単位のつけ間違いはない。
また平方フィート、平方マイル、平方チェイン、平方ヤードも該当する記号はないため、上付き数字を追加して単位記号を合成している。

記号と換算係数について

  • 平方メートルはそのまま記号を使う。
  • 平方kmもそのまま記号を使う。または上付き数字を組み合わせる。換算するために1,000,000で割る。
  • 坪は400/121の逆数0.3025を使って換算し、単位は漢字の坪を使う
  • アールは全角アール ㌃ HTMLでは10進で`㌃` `chrw("&H3303")`しかないので、これを使うが、アルファベットaでよい。換算するためには100で割る。
  • ヘクタールは全角ヘクタール`chrw("&H3336")` ヘクタール記号`chrw("&H33CA")` がある。しかし、使用が推奨されないためhaとアルファベットを組み合わせる。換算するために10,000で割る。
  • アールやヘクタールは使用が推奨されないものの、平方キロは100万倍のため、非常に使い勝手が悪く、今後も使用されると思われる。
  • 1坪=1歩、30歩=1畝、10畝=1反（段）、1町歩は10反＝100畝とする

VBAのコード

平方メートルを入力するとフィールドコードが挿入される。書式は、平方メートルが追加され、コンマつき小数点2位で四捨五入される

Sub InsertFieldCodeWithSuareMeter()
' for Word VBA
' To Show Land Area.
' Input Square Meters, Insert Field Code Format add SquareMeter Unit character And comma, and point 2 round
Dim x
x = InputBox("面積を入力するとコンマつき小数点2位、㎡を表示します", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=" & x, NumberFormat:="#,0.00㎡"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

平方キロメートルを平方キロメートルとして単位を付加して端数処理したフィールドコードを挿入

よく考えると、平方キロメートルを平方メートル単位で入力することは学習するとき以外はないのではないか。
ならばキロメートルのままというのも必要だろう。

Sub InsFldCodeWithSuareKiloMetercommapoint2withUnit()
' for Word VBA
' Input Square KiloMeters, Insert Field Code Format add Square KiloMeter Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積を平方キロメートル入力するとコンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=" & x, NumberFormat:="#,0.00" & "'" & ChrW("&H33A2") & "'"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
またはフィールドコードに近い形で書く方法
Sub InsFldCodeWithSuareKiloMetercommapoint2withUnit1()
' for Word VBA
' Input Square KiloMeters, Insert Field Code Format add Square KiloMeter Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積を平方キロメートル入力するとコンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=" & x & " \#""#,0.00'" & ChrW("&H33A2") & "'"""
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Mergefieldは0.56になり、結果がおかしく、使えない
Sub InsFldCodeWithSuareKiloMetercommapoint2withUnit2()
' Do not Use This code. This is only for test of mergefiled.
' for Word VBA
' Input Square KiloMeters, Insert Field Code Format add Square KiloMeter Unit character And With comma, and point 2 round
' これは失敗します。たとえばxが1234になったり、結果が0.56と表示されます。
Dim x
x = InputBox("面積を平方キロメートル入力するとコンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.TypeText Text:="Mergefield """ & x & """ \#""#,0.00'" & ChrW("&H33A2") & "'"""
    Selection.Fields.Update
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

平方メートルをアールに(整数位）

ヘクタールとアールは小数点以下はつかないと思われる。
全角アールを使っている

Sub InsFldCodeSquarMeterstoアール()
' for Word VBA
' for Land area
' Input Square KiloMeters, Insert Field Code Format add are Unit character And With comma, and round
Dim x
x = InputBox("面積㎡単位で入力するとコンマつき、アールに換算して表示します(整数位で四捨五入)", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=" & x & " / 100", NumberFormat:="#,0㌃"
    'Selection.InsertFormula Formula:="=" & x & " / 100", NumberFormat:="#,0'a'"
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

平方メートルをヘクタールに(整数位）

ヘクタールとアールは小数点以下はつかないと思われる。
haを使っている

Sub InsFldCodeSquarMeterstoヘクタール()
' for Word VBA
' Input Square Meters, Insert Field Code Format add hectare Unit character And With comma, and round
Dim x
x = InputBox("面積を㎡単位で入力するとコンマつき、ヘクタール換算で表示します(整数位で四捨五入)", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    'Selection.InsertFormula Formula:="=" & x & " / 10000", NumberFormat:="#,0㌶"
    Selection.InsertFormula Formula:="=" & x & " / 10000", NumberFormat:="#,0'ha'"
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

平方メートルを平方キロメートルに（小数点2位四捨五入で2位表示)

Sub InsFldCodeSquarMeterstoSuareKillometerWithcommaround2()
' for Word VBA
' Input Square Meters, Insert Field Code Format add Square Kilometers Unit character And With comma, and round 2 point
Dim x
x = InputBox("面積㎡単位で入力するとコンマつき小数点2位、平方キロで表示します", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    'Selection.InsertFormula Formula:="=" & x & " / 100000", NumberFormat:="#,0.00" & ChrW("&H33A2")
    Selection.InsertFormula Formula:="=" & x & " / 100000 \#""#,0.00'" & ChrW("&H33A2") & "'"""
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

上つき数字を使う平方メートルを平方キロメートルに（小数点2位四捨五入で2位表示)

上つき数字もフィールドコードを使う。

Sub InsFldSquareMetertoSquareKillometerUp2()
' for Word VBA
' Input Square Meters, Insert Field Code Format add km and upper 2 And With comma, and round 2 point
Dim x
x = InputBox("面積㎡単位で入力するとコンマつき小数点2位、平方キロで表示します", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
   Selection.InsertFormula Formula:="=" & x & " / 1000000", NumberFormat:="#,0.00'km'"
      Selection.MoveRight Unit:=wdCharacter, Count:=1
          Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.TypeText Text:="EQ \s \up(2)"
  Selection.Fields.ToggleShowCodes
End Sub

平方メートルを坪（整数位切捨て）に換算

これは200平米を四捨五入すると、61坪になるが、通常は61坪ではなく（約）60坪である。
つまり概数を示すためのものなので（価格を計算する数量の単位としては法律で使用が禁止）切捨てにしている。

Sub ShowNumberWithSuare概数坪()
Dim x
x = InputBox("面積平方メートル単位で入力するとコンマつき整数位端数切捨て、単位：坪のフィールドコードを挿入します", "面積表示フィールドコードの挿入", 200)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT(" & x & "*0.3025) \# ""#,0'坪'"""
        Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

フィールドコードなし平方メートルを町反畝歩に

昔はメートル単位ではなく町反畝歩で換算していました。
さすがにこれはフィールドコードでは無理なので、Selection.InsertAfterで文字列で入れています。
歩未満は切り捨てです。つまり3.3025に満たないと0になります。
坪で本気を出すのは小数点以下ではなく、整数位です。

Sub Ins町反畝歩()
Dim x
Dim u町 As Long, u反 As Long, u畝 As Long, u歩 As Long
x = InputBox("面積平方メートル単位で入力すると町反畝歩で表示します", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
u町 = CDec(x \ CDec(9917.36))
x = x - (u町 * 9917.36)
u反 = CDec(x \ CDec(991.736))
x = CDec(x - (u反 * 991.736))
u畝 = x \ CDec(99.1736)
x = CDec(x - (u畝 * 99.1736))
u歩 = x \ CDec(99.1736 / 30)
Selection.InsertAfter Text:=IIf(u町 <> 0, u町 & "町歩", "") & IIf(u反 <> 0, u反 & "反", "") & IIf(u畝 <> 0, u畝 & "畝", "") & IIf(u歩 <> 0, u歩 & "歩", "0")
End Sub

東京ドームの約何倍表示

建築面積の46,755平方メートルを使うと公式にある。
これは読売新聞の宣伝のためというのもあるが、実はこれ、ほぼ5ヘクタールであり、数字的にもわりと意味がある。
単純に平方メートルを50000で割ると何倍か計算できる。

Sub InsfldSquareMeterto東京ドーム()
' for Word VBA
' Input Square Meters, Insert Field Code Format Tokyo Dome Unit ,point 1 round
Dim x
Const unit東京ドーム = 46755

x = InputBox("4675㎡以上の面積を平方メートル入力するとコンマつき,小数点1位四捨五入1位表示、東京ドームの面積の何倍をフィールドコードで挿入します。", "面積表示フィールドコードの挿入", 123456.555)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
If x < 4675 Then Exit Sub ' 東京ドームと比較するため0．1以下は0になり、意味がない。
On Error GoTo 0
    Selection.InsertFormula Formula:="=" & x & "/" & unit東京ドーム, NumberFormat:="'東京ドームの約'#,0.0'倍'"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

平方（キロ）メートルからヤードポンド法

単位記号は合成

該当する記号がないため、上付き数字を追加して平方にしている。
このため、行末では単位記号がmi 改行 2となることもありうる。
また、平方マイルは本当に大きくて、1平方キロメートルですら0.3mi2にしかならない。

平方キロから平方マイル

Sub InsFldCodeWithSuarekiloMeterToSqmicommapoint2withUnit()
' for Word VBA
' Input Square Meters, Insert Field Code Format add square mile Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積を平方「キロ」メートルで入力すると平方マイルに換算し、コンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 5000)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT((" & x & "*( 38.610215854245/100))*100+0.5)/100", NumberFormat:="#,0.00" & "'mi'"

    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
                                            PreserveFormatting:=False
    Selection.TypeText Text:="EQ \s \up(2)"
  Selection.Fields.ToggleShowCodes
      Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

以下は平方メートルからの換算になる

平方メートルから平方フィート

Sub InsFldCodeWithSuareMeterToSqftcommapoint2withUnit()
' for Word VBA
' Input Square Meters, Insert Field Code Format add acer Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積を平方メートルで入力すると平方フィートに換算し、コンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 5000)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT((" & x & "*(10763910.41671/1000000))*100+0.5)/100", NumberFormat:="#,0.00" & "'ft'"

    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
                                            PreserveFormatting:=False
    Selection.TypeText Text:="EQ \s \up(2)"
  Selection.Fields.ToggleShowCodes
      Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

平方メートルから平方ヤード

Sub InsFldCodeWithSuareMeterToSqYdcommapoint2withUnit()
' for Word VBA
' Input Square Meters, Insert Field Code Format add acer Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積を平方メートルで入力すると平方ヤード（ヤール）に換算し、コンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 5000)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT((" & x & "*(1195990.0463011/1000000))*100+0.5)/100", NumberFormat:="#,0.00" & "'yd'"

    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
                                            PreserveFormatting:=False
    Selection.TypeText Text:="EQ \s \up(2)"
  Selection.Fields.ToggleShowCodes
      Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

平方メートルから平方チェイン

Sub InsFldCodeWithSuareMeterToSqChcommapoint2withUnit()
' for Word VBA
' Input Square Meters, Insert Field Code Format add acer Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積を平方メートルで入力すると平方チェーンに換算、コンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 5000)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT((" & x & "*(2471.0538146717/1000000))*100+0.5)/100", NumberFormat:="#,0.00" & "'ch'"

    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
                                            PreserveFormatting:=False
    Selection.TypeText Text:="EQ \s \up(2)"
  Selection.Fields.ToggleShowCodes
      Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

ところでこうした単位が農作業に繋がっているのが興味深い。測量と農業は中国、日本、ヨーロッパで極めて明確に結合している。作物がどれくらい取れるか、そういう計算をするために測量が発達し、単位が作られている。もともとは作物がある一定量取れる、または雄牛一頭で耕作可能な面積を1反や1エーカーとしている。つまりある単位が何平方メートルかは本当は意味がなくて、ある単位はなにをもって1単位としているかが重要だということになる。

平方メートルからルードへ

Sub InsFldCodeWithSuareMeterToRoodcommapoint2withUnit()
' for Word VBA
' Input Square Meters, Insert Field Code Format add acer Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積を平方メートルで入力するとルードに換算でコンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 5000)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT((" & x & "*(988.42152586866/1000000))*100+0.5)/100", NumberFormat:="#,0.00" & "'ro'"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

ところで、
1ac = 4ro = 4840 yd2
1yd2 = 9ft2
という関係が成立しているが、上記の単位はCasioの高度計算サイトで1平方キロの換算値を割っている。
このため、きれいにこの関係が成立していない場合もある。

平方メートルからエーカーへ

Sub InsFldCodeWithSuareMeterToAcrecommapoint2withUnit()
' for Word VBA
' Input Square Meters, Insert Field Code Format add acer Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積を平方メートルで入力するとエーカーに換算、コンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 5000)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT((" & x & "*(247.10538146717/1000000))*100+0.5)/100", NumberFormat:="#,0.00" & "'ac'"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

エーカーから平方メートルへ

Sub InsFldCodeWithAcreToSuareMetercommapoint2withUnit()
' for Word VBA
' Input Square Meters, Insert Field Code Format add acer Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積をエーカーで入力すると平方メートルに換算、コンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 5000)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT((" & x & "*(1000000/247.10538146717))*100+0.5)/100", NumberFormat:="#,0.00" & "'ac'"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

逆にエーカーや平方フィートからどうやって平方メートルを出すか。

まずSub プロシージャの名前を SuareMeterToAcreをひっくり返して、 AcreToSqMeterにする
InputBoxのメッセージをひっくり返す
面積をエーカー単位で入力すると平方メートルに換算し、以下同文

平方メートルは上付き数字がいらないので、以下の行があれば消す。

    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
                                            PreserveFormatting:=False
    Selection.TypeText Text:="EQ \s \up(2)"
  Selection.Fields.ToggleShowCodes

"#,0.00" & "'ac'"単位表記を変える。　"#,0.00" & "'㎡'"

そして最後に分数をひっくり返す
247.10538146717/1000000 1000000/247.10538146717

Sub InsFldCodeWithAcreToSuareMetercommapoint2withUnit()
' for Word VBA
' Input Acre , Insert Field Code Format add square meter Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積をエーカー単位で入力すると平方メートルに換算し、コンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 5000)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT((" & x & "*(1000000/247.10538146717))*100+0.5)/100", NumberFormat:="#,0.00" & "'㎡'"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub InsFldCodeWithAcreToHectarecommapoint2withUnit()
' for Word VBA
' Input Acre , Insert Field Code Format add square meter Unit character And With comma, and point 2 round
Dim x
x = InputBox("面積をエーカー単位で入力するとヘクタールに換算し、コンマつき、小数点2位四捨五入で2位表示、単位記号を追加します", "面積表示フィールドコードの挿入", 5000)
On Error Resume Next
If x <> CDbl(x) Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
    Selection.InsertFormula Formula:="=INT((" & x & "*(1000/2471.0538146717))*100+0.5)/100", NumberFormat:="#,0.00" & "'Ha'"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

これで計算するとエーカーは1エーカーは0.4ヘクタールで換算すると概数が得られるし、簡単だとわかる。
くまのプーさんは100エーカーの土地に、つまり40ヘクタールに住んでいる。
大地主である。どんだけはちみつを食ってるんだあいつは。固定資産税をふんだくる。。。わけにも行かない。日本国内ではないので税法が及ばない。また、計算サイトを見ると、林業関連のほか、翻訳関係が多いようだ。この林業や翻訳ではこのマクロが使えそうである。しかし、林業や農業は単純に一反が何平方メートルでは足りない。上記のような換算が必要である。またヤードポンドが使用禁止のため、換算が発達していないため、翻訳で困ることになる。

すべてのフィールドコードの表示を切り替える

https://qiita.com/Q11Q/items/44280bc93fbea84e4b28
にもあげてありますが、一応。

Sub ToggleShowCodeOfFieldCodesInDocument()
' For Word VBA
' Documentのすべてのフィールドコードについてコード表示させるかどうかを反転させる
Dim wDoc As Document: Set wDoc = ThisDocument
Dim fc As Field, i As Long
If wDoc.Fields.Count > 0 Then
For i = wDoc.Fields.Count To 1 Step -1
Set fc = wDoc.Fields(i)
fc.ShowCodes = Not fc.ShowCodes
Next
End If
End Sub

仕上げにテキスト化するとき、EQフィールドを除く

ロックされたものを除き更新後テキスト化

Sub FieldCodeQuickUnlinkExceptEQfield()
' For Word VBA
' 上付き数字のEQフィールドを除き、更新後テキスト化する
' ロックされているものは更新されないでテキスト化される
Selection.WholeStory
With Selection
.Fields.Update
.Fields.Unlink
End With
End Sub

正規表現で選択できるバージョン

いずれにしてもEQフィールドは残ります。

Sub FieldCodeUnlinkExceptEQfield()
' For Word VBA
' 上付き数字のEQフィールドを除き、テキスト化する
' 未保存の場合には動かない
' 保存されているフォルダに、ランダムな名前で、フィールドのリストを作ってからテキスト化する。
Dim wDoc As Word.Document: Set wDoc = ThisDocument
Dim wFld As Word.Field
Dim wFlds As Word.Fields
Dim Reg, iMatch, MC, M: Set Reg = CreateObject("VBScript.RegExp")
Dim FSO, ofolder, TextStream: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim t1, bl As Boolean
If ThisDocument.Saved = False Then
MsgBox "フィールドコードをテキスト化する前に、保存してください、終了します", vbCritical + vbOKOnly, "未保存です"
Exit Sub
End If
t1 = MsgBox("ロック（更新がされない処理）をしているフィールド（コード）を解除してから更新してテキスト化する場合はYesを、ロックされているものを除いて更新後テキスト化する場合はNoを（推奨）をやめるときはCancelをクリックしてください", vbYesNoCancel, "ロックされたフィールドコードの処理の確認")
If t1 = vbCancel Then Exit Sub
If t1 = vbYes Then
bl = True
ElseIf t1 = vbNo Then
bl = False
End If
Set ofolder = FSO.getfolder(ThisDocument.Path)
With Reg
.Global = True
.IgnoreCase = False
.MultiLine = True
.Pattern = "EQ\s\\"
End With
Set wFlds = wDoc.Fields
If wFlds.Count > 0 Then
Set TextStream = FSO.Opentextfile( _
                                   FSO.BuildPath( _
                                                     ThisDocument.Path, _
                                                     FSO.getbasename( _
                                                        FSO.gettempname _
                                                                                ) _
                                                       ) _
                                                   & ".txt", 2, True, -1 _
                                                 )
TextStream.WriteLine ThisDocument.FullName
TextStream.WriteLine "Field Code List"
TextStream.WriteLine "Code" & AddvbTab("Type") & AddvbTab("Locked") & AddvbTab("Index") & AddvbTab("kind") & AddvbTab("Result")

For Each wFld In wFlds
On Error Resume Next
TextStream.WriteLine Chr(34) & wFld.Code & Chr(34) & vbTab & AddvbTab(wFld.Type) & AddvbTab(wFld.Locked) & AddvbTab(wFld.Index) & AddvbTab(wFld.Kind) & AddvbTab(wFld.Result)
On Error GoTo 0
If Err.Number <> 0 Then
TextStream.WriteLine Chr(34) & "Error.occur" & Chr(34) & vbTab & AddvbTab(Err.Number) & AddvbTab(Err.Description) & AddvbTab(Err.Source) & vbTab & vbTab
Err.Clear
End If
If wFld.ShowCodes = True Then wFld.ShowCodes = False
  If bl = False Then
    If wFld.Locked = True Then wFld.Locked = False
  End If
Next
TextStream.Close
Set FSO = Nothing
Selection.WholeStory
Selection.Fields.Update

For Each wFld In wFlds
If Not Reg.test(wFld.Code) Then
wFld.Select
wFld.Unlink
End If
Next
End If
Set Reg = Nothing
End Sub

参考文献

Word：EQフィールドの使い方(\Sスイッチ ）上付き・下付き文字
http://office-qa.com/Word/wd805.htm
Word2010 フィールドの書式スィッチ
http://www4.synapse.ne.jp/yone/word2010/word2010_field_sutisyo.html
Word差し込み印刷：数値の表示形式を指定する（3桁区切り他
http://office-qa.com/Word/wd567.htm
Word2010-2016：フィールドコード 共通スイッチ（まとめ）
http://office-qa.com/Word/wd601.htm
計算サイト　面積の換算
https://www.calc-site.com/units/area/10
高度計算サイト　 Casio
https://keisan.casio.jp/exec/system/1236214087

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?