エクセルVBAでMsgboxの表示をそろえたい

質問

ワークシート上の数値をメッセージボックスで表示させるため、下記のようなVBAを書きました。

Sub 金額表示()

Dim a As Long, b As Long, c As Long

a = Sheets("logic").Range("P39").Value
b = Sheets("logic").Range("O46").Value
d = Sheets("logic").Range("O44").Value

MsgBox "合計の金額は、" & Format(d, "##,###万円") _
+ Chr(&HD) + Chr(&HA) + "○○は、" & Format(a, "##,###万円") _
+ Chr(&HD) + Chr(&HA) + "○○○○は、" & Format(b, "##,###万円"), vbInformation, "確認"

End Sub

○○部分の文字数や、金額の桁数により、表示される数字の位置ははかなりずれがあります。
これを円で後ろでそろえ統一するような方法はないでしょうか？
出来れば後ろでそろえても○○の部分も頭をそろえておきたいですが、それが無理なら後揃えだけでも結構です。
よろしくお願いします。

回答No.6

ja7awu

> ならば、セル内での右寄せ同様に後ろだけ揃えることは不可能でしょうか？

今までのことは、全て後ろを揃えることについて言っているのです。

MsgBox関数の第一引数であるpromptについての右揃え等の表示位置の機能は
無いのです。全て左から順に表示です。TABが使えるぐらいです。

従って、後ろを揃えるには、等幅フォントを用いて全体の字数合わせるより
方法は無いのです。 「MS ゴジック」だと全角は半角の２倍幅になります。

何故、MsgBox関数に固執するのですか？

後ろをキチット揃えたい気持ちは解りますが・・・

前に言ったようにユーザーフォームを使えば、自由自在になると思いますが、
何故ダメなのですか？　

何が何でも、ゼッ～～～ッタイ MsgBoxを使って目的を達成しようとするので
あれば、Win32APIを勉強されたら良いかと思います。

MsgBox関数を実行する前に、当方が最初に書いたようにシステム(OS)における
「メッセージボックス」の「フォント」の種類を取得した後に、「MS ゴジック」
等の「等幅フォント」に変更し、MsgBox を使用後に元のフォント種に戻す
ということをAPIを使ってVBAで実行することだと思います。

しかし、当方の持っている安物のAPIの参考書には、該当する関数は、記載されて
おりません。　出来るかどうかも解りません。　いずれにしても可也難しいです。

繰り返しますが、すんなり諦めてユーザーフォームをお使いになることを
お勧めします。

補足

何故、MsgBox関数に固執するのか。

理由1.ユーザーの中に未だoffice95を使用している人間が少数ですが存在するのです。したがってユーザーフォームは使えません。

理由2.
私自身がoffice95でマクロを学んだためコントロールツールボックス系はよくわかっていないのです。

どうしても無理であればユーザーフォームではないですがDialogSheetを挿入して作って見ようかと考えています。

いろいろ勝手を申しすみませんでした。
ありがとうございました。

回答No.5

ja7awu

前にも言ったように「文字幅等間隔フォント」でないと無理ですよ。

Web上、連続スペースは、削られてしますますので代わりに、I と H が10個ずつ
ですが、下記を実行してみてください。

数字10個とカンマ10個でもいいですよ。

これでもう　カンマの数が違うとそれだけでも、もう右端は揃わないことが
お解りでしょう。

桁数が違う金額に、桁数が同じになる分だけ数字の左側にスペースを補って
テストしてみてください。

Sub test()
MsgBox "IIIIIIIIII" & vbLf & "HHHHHHHHHH"
End Sub

お礼

何度もありがとうございます。
なるほど理屈は良くわかりました。
ならば、セル内での右寄せ同様に後ろだけ揃えることは不可能でしょうか？「文字幅等間隔フォント」の設定も自分のＰＣだけでの設定では無意味なのです。

回答No.4

imogasi

＃２です。
半角の数字にしたいなら
（１）a = "０１２３４５６７８９" を半角のテーブルに
a="0123456789"に変える
（２）台紙的な
k = "　　　　　　　　　　" '１０桁に設定
を半角のスペースに変える。下記では」Ｓｐａｃｅ関数を使用した。
Mid(k, p, 1) = "，" をMid(k, p, 1) = ","
と半角に変える。
だけで
他はそのままで動くと思います。やって見てください。
幸いＭｉｄ関数は、全角ばかりの時は全角で数えた文字数を、半角ばかりの文字列の場合は半角の文字数を返すようですから。
数を１０桁まで対応するため
If p = 7 Or p = 3 Then
の７と３のところを修正しました。
Function edt(n)
a = "0123456789"
k = Space(15) '１2桁+カンマ3桁に設定
s = n
p = Len(k)
For i = Val(Len(s)) To 1 Step -1
If p = Len(k) - 3 Or p = Len(k) - 7 Or p = Len(k) - 11 Then
Mid(k, p, 1) = ","
p = p - 1
End If
q = (s Mod 10) + 1
'MsgBox Mid(a, q, 1)
Mid(k, p, 1) = Mid(a, q, 1)
p = p - 1
s = Int(s / 10)
Next i
edt = k
' MsgBox k
End Function
'------
Sub test01()
MsgBox "*" & edt(123456788) '頭部スペースを見るため＊を添えた
End Sub

補足

ありがとうございました。
下記のようにやりましたが、数字がすべて同じ桁数ならきちんと後ろもそろうのですが、桁違いだとずれが発生しました。どこが悪いのでしょうか？

Function edt(n)
a = "0123456789"
k = Space(15) '１2桁+カンマ3桁に設定
s = n
p = Len(k)
For i = Val(Len(s)) To 1 Step -1
If p = Len(k) - 3 Or p = Len(k) - 7 Or p = Len(k) - 11 Then
Mid(k, p, 1) = ","
p = p - 1
End If
q = (s Mod 10) + 1
'MsgBox Mid(a, q, 1)
Mid(k, p, 1) = Mid(a, q, 1)
p = p - 1
s = Int(s / 10)
Next i
edt = k
' MsgBox k
End Function

Sub test02()
Dim a As Long, b As Long, c As Long
a = Sheet1.Range("A1").Value
b = Sheet1.Range("A2").Value
d = Sheet1.Range("A3").Value
MsgBox "○○○○○は" & edt(a) & "円" _
+ Chr(&HD) + Chr(&HA) + "○○○○○は" & edt(b) & "円" _
+ Chr(&HD) + Chr(&HA) + "○○○○○は" & edt(d) & "円", vbInformation, "確認"
End Sub

回答No.3

ja7awu

後ろを揃えるということは、前後を揃えることになると思いますよ。

フォント種類を等間隔文字(全角が半角の２倍で、スペースも文字と同幅)にしないと
キチ～ット揃えることは、出来ないと思います。
プロポーショナル等フォントはスペースと文字で字幅がそれぞれ違いますので、
右端を揃えるのは出来ないでしょう。

このようなときは、ユーザーフォームを使いましょう。
色も使えるし、配置も自由自在です。

回答No.2

imogasi

（１）コメントの部分をまず揃えましょう
"合計の金額は、" 　　７字だから
"○○は、" も"○○は、　　　" と７字に
"○○○○は、" も"○○○○は、　"と７字にする。
（２）数字を１０桁に右揃えにそろえる。
右詰め、３桁ごとカンマ付きの全角文字列にします。
下記コードを参考に。
Function edt(n)
a = "０１２３４５６７８９"
k = "　　　　　　　　　　" '１０桁に設定
s = n
p = Len(k)
For i = Val(Len(s)) To 1 Step -1
If p = 7 Or p = 3 Then
Mid(k, p, 1) = "，"
p = p - 1
End If
q = (s Mod 10) + 1
'MsgBox Mid(a, q, 1)
Mid(k, p, 1) = Mid(a, q, 1)
p = p - 1
s = Int(s / 10)
Next i
edt = k
' MsgBox k
End Function
'------
Sub test01()
MsgBox "*" & edt(12345)
End Sub
（１）と（２）の両者を、Ｍｓｇｂｏｘの文字列の中で組み合わせてください。
夜遅いので省略で失礼。

補足

ありがとうございます。
全角ではなく、半角の数字でそろえたいのです。
後ろだけでもかまいません。よろしくお願いします。

回答No.1

ja7awu

コントロールパネルの中の「画面」を開き、「デザイン」タブで、「指定する部分」を
「メッセージボックス」にして、「フォント」を「MS ゴジック」にし、[適用]、[OK]
します。

これで、下記コードを実行すると前後が、キチット揃うと思います。

中間の間隔は、27の値で調整します。

これで如何でしょうか。

Sub 金額表示()

Dim a As Long, b As Long, c As Long
Dim x As Integer, y As Integer, z As Integer

Const xm = "合計の金額は、" '　<--- 全部全角
Const ym = "○○は、" '　　　　　<---　〃
Const zm = "○○○○は、" '　　<---　〃

a = Sheets("logic").Range("P39").Value
b = Sheets("logic").Range("O46").Value
c = Sheets("logic").Range("O44").Value

x = 27 - LenB(xm) - LenB(StrConv(Format(c, "##,###万円"), vbFromUnicode))
y = 27 - LenB(ym) - LenB(StrConv(Format(a, "##,###万円"), vbFromUnicode))
z = 27 - LenB(zm) - LenB(StrConv(Format(b, "##,###万円"), vbFromUnicode))

MsgBox xm & String(x, " ") & Format(c, "##,###万円") & vbLf & _
　　ym & String(y, " ") & Format(a, "##,###万円") & vbLf & _
　　zm & String(z, " ") & Format(b, "##,###万円"), vbInformation, "確認"

End Sub

補足

ありがとうございました。
これで自分のPCではちゃんと揃いましたが、他人のPCではダメですよね？
他人のPCのせっていによらず、そろえたいのです。
頭と後ろの両方をそろえられなくとも後ろだけでもかまいません。よろしくお願いします。