横書きの半角数字を、縦表示にしても，横に「・・・」と並べるには？

質問

リンクさせたデータの中に「123（半角）」があったとして、
これを縦書きで表示させたいときに、
横に「123」と並べることはできますか？

例えて書けば・・・
「これは123円です」のデータをリンクさせて、縦書き表示にしたくて、

　こ
　れ
　は
　123
　円
　で
　す

みたいなイメージ???
１でも２でも折り返されたくなくて、３で折り返されたい感じ???
加えて、必ずしも3文字とも決まっていなくて・・・

具体的に記述して教えていただけると、ありがたいです。
かなりワガママですが、コメントを入れてください・・・
お願いします。

回答No.7

nishi6 · ベストアンサー

予想通りの指摘ですね。自分でも見苦しいかなと思っていました。

縦書きはセル単位指定のため『。、』のみを縦書きにするのは難しそうです。
『。、』のみ強制的に縦書フォントに変えてみましたが、回転できないのでうまくいきませんでした。

より自然に見えるようにしてみました。（Excelの縦書きと比べて）
『。』はなんとかごまかせている？『、』は苦しいかも知れません。現時点ではこれが最善です。
最後の方を下記のようにしてみて下さい。

　　Next
　　'『。、』を縦書き風に見せる対応
　　TateGaki = Application.Substitute(TateGaki & Right(moji, 1), "。", " " & " " & Chr(223))
　　TateGaki = Application.Substitute(TateGaki, "、", " " & "｀")
　　HankakuYokogaki = TateGaki
End Function

次に、別の考え方でマクロを作ってみました。これはExcelの縦書きと同じ表示になります。
値や式の入っているセルがA1とすると、縦に書きたいセルに=A1として表示させます。そのセルを選択したまま下記のマクロを実行します。
指定したセルから下に向かって順に文字を分割して表示します。セルの高さを操作する必要はありません。セルの結合もしません。

コピーして標準モジュールに貼り付けます。（マクロをショートカットキーを割り当てた方が楽です）
縦書きにした時に【】などを上下にしたい場合は、If InStr("　")　に全角で挿入して下さい。

Public Sub HankakuYokogaki2()
　　Dim rg As Range '縦書きにするセル
　　Dim moji As String 'セルの文字
　　Dim L As Integer 'カウンタ
　　Dim elm1, elm2, Welm As String '前後の１文字と書き出す文字
　　Dim mojiCD1, mojiCD2 As Long '前後の文字の文字コード
　　Dim kaigyo As Boolean '改行有無
　　Dim rowCot As Integer '書き出す行位置
　　Dim cutPot As Integer '書き出す文字の開始位置

　　Application.ScreenUpdating = False
　　Set rg = ActiveCell
　　moji = rg.Text & " " '前後で判定するので1文字ダミーで増やしておく
　　cutPot = 1
　　For L = 1 To Len(moji) - 1
　　　　elm1 = Mid(moji, L, 1): mojiCD1 = Asc(elm1) '調べる文字
　　　　elm2 = Mid(moji, L + 1, 1): mojiCD2 = Asc(elm2) '調べる文字の次の文字

　　　　kaigyo = True
　　　　If 48 <= mojiCD1 And mojiCD1 <= 57 Then
　　　　　　If 48 <= mojiCD2 And mojiCD2 <= 57 Then
　　　　　　　　kaigyo = False '半角数値が続いたら改行しない
　　　　　　End If
　　　　End If
　　　　　　If kaigyo = True Then '改行する場合
　　　　　　　　Welm = Mid(moji, cutPot, L - cutPot + 1)
　　　　　　　　With rg.Offset(rowCot, 0)
　　　　　　　　　　.Value = Welm
　　　　　　　　　　.HorizontalAlignment = xlCenter 'センタリング
　　　　　　　　　　.Orientation = 0 '横書きにしておく（初期値）
　　　　　　　　　　If InStr("。、ゃゅょャュョっッぁぃぅぇぉァィゥェォ（）", Welm) > 0 Then
　　　　　　　　　　　　.Orientation = xlVertical '句読点、小文字なら縦書きにする
　　　　　　　　　　End If
　　　　　　　　End With
　　　　　　　　cutPot = L + 1 '書き出す位置を進める
　　　　　　　　rowCot = rowCot + 1 '書き込む行を進める
　　　　　　End If
　　Next
　　Application.ScreenUpdating = True
End Sub

お礼

これで十分です。
本当にありがとうございました。
アナタのような方は、本当に貴重です。
また見かけたらお世話してください。

回答No.6

nishi6

＞どうしても・・・どうしても・・・うまく使いこなすことができません・・・。

まず、ANo.#3は一部誤りがあったのでANo.#4の修正をお願いします。
　=HankakuYokogaki(今ある算式)
をセットしたセルの書式は、
　（１）折り返して全体を表示する（配置タグ）
　（２）方向は横書き（分度器みたいに見えるほうで0度。初期値です）
　（３）セルの高さは全体が表示できる高さに増やします。
　（４）セルの幅も半角横書き部分が表示できる幅に増やします。

とします。エラー表示が出るのであれば補足してください。

お礼

お礼が遅くなりました。
ネットカフェで試すとうまくできるのですが、どういうわけか自宅に帰ると・・・。
でも、ここで試すと「！！！」です。
本当に感激です。
ありがとうございました。

ところで、リンク元に「。」や「、」があると、見た感じ、ヘンですね（笑）。
何か解決策はありますか？
もう本当に贅沢すぎ。。。
今後も知恵を貸してくださいね。

回答No.5

ARC

>実は…ＶＢで具体的に記述していただけると、「！！！」でした。

ちょっと時間が空いたんで、実際に作ってみました。

フォームにピクチャボックス(Picture1),テキストボックス(Text1),ボタン(縦書きボタン)を配置して、以下のようにコーディングしてください。
Picture1のAutoRedrawはTrueに設定しときます。

テキスト中の$H(文字列)を縦中横表示します。
特殊書式の文法チェックとか、ピクチャボックス外にはみ出したときの処理とかは入ってません。
句読点の位置とかもおかしくなるんで、句読点についての処理も入れたほうがいいですね。

一応それなりにコメント入れましたが、不明点とかあったら補足してください。

****************************************************

Option Explicit
Const MARGIN_TOP = 5 * 56.7 '上余白5mm
Const MARGIN_RIGHT = 5 * 56.7　'右余白5mm
Const LETTER_SPACING = 1 * 56.7　'字間1mm
Const LINE_HEIGHT = 10 * 56.7 '行間10mm

Private Sub Form_Load()
　Me.Text1 = "これは$H(123)円です。"
End Sub

Private Sub 縦書きボタン_Click()
　Dim Text As String
　Dim DrawChar As String
　Dim i As Long
　Dim x As Single, y As Single '字を書く座標(ｘは行の中心線)
　Dim StPos As Long, EdPos As Long　'文字列内の位置情報
　Text = Me.Text1

　Me.Picture1.Cls
　Me.Picture1.FontName = "ＭＳ ゴシック"
　x = Me.Picture1.Width - MARGIN_RIGHT - (Me.Picture1.TextWidth("あ") / 2)
　y = MARGIN_TOP
　For i = 1 To Len(Text)
　　DrawChar = ""
　　'文字を一文字ずつ検査する。
　　Select Case Mid$(Text, i, 1)
　　　Case vbCr, vbLf '改行コード
　　　　x = x - LINE_HEIGHT
　　　　y = MARGIN_TOP
　　　　If Mid$(Text, i + 1, 1) = vbLf Then i = i + 1
　　　Case "$" '特殊書式
　　　　'TODO:異常な文法に対する処理を入れること

　　　　Select Case Mid$(Text, i + 1, 1)
　　　　　Case "$"　'"$$"は"$"一文字とみなす
　　　　　　DrawChar = "$"
　　　　　　i = i + 1
　　　　　Case "H"　'$H(文字列)は、文字列を縦中横表示
　　　　　　StPos = i + 3
　　　　　　EdPos = InStr(StPos, Text, ")", vbBinaryCompare)
　　　　　　DrawChar = Mid$(Text, StPos, EdPos - StPos)
　　　　　　i = EdPos
　　　　　Case Else'書式指定が間違ってる
　　　　　　Debug.Assert True
　　　　End Select
　　　Case Else
　　　'通常の文字
　　　　DrawChar = Mid$(Text, i, 1)
　　End Select

　　'文字を描画
　　If DrawChar <> "" Then
　　　With Me.Picture1
　　　　.CurrentX = x - (.TextWidth(DrawChar) / 2)
　　　　.CurrentY = y
　　　　Me.Picture1.Print DrawChar
　　　　y = y + .TextHeight(DrawChar) + LETTER_SPACING
　　　End With
　　End If
　Next i
End Sub

お礼

あまりにもご丁寧で・・・感激→ダウン気味（笑）
ありがとうございました。

回答No.4

nishi6

最後から２行目を書き換えて下さい。回答文書を記入中に関数名を変えてしまいました。

　　HankakuTategaki = TateGaki & Right(moji, 1)
　　　　　↓
　　HankakuYokogaki = TateGaki & Right(moji, 1)

回答No.3

nishi6

Excelと仮定して回答します。ユーザー定義関数を作ってみました。
　　=HankakuYokogaki(今ある算式) として使います。
セルの書式は配置タブで、『折り返して全体を表示する』にチェック。方向は横書きにします。
Wordだったらすいません。参考にして下さい。

標準モジュールに貼り付けて下さい。
Public Function HankakuYokogaki(moji As String)
　　Dim L As Integer 'カウンタ
　　Dim elm1, elm2 As String '１文字
　　Dim mojiCD1, mojiCD2 As Long '文字コード
　　Dim TateGaki As String '縦書き文字
　　Dim kaigyo As Boolean '改行有無
　　For L = 1 To Len(moji) - 1
　　　　elm1 = Mid(moji, L, 1): mojiCD1 = Asc(elm1)
　　　　elm2 = Mid(moji, L + 1, 1): mojiCD2 = Asc(elm2)

　　　　kaigyo = True
　　　　'半角数値が続いたら改行しない
　　　　If 48 <= mojiCD1 And mojiCD1 <= 57 Then
　　　　　　If 48 <= mojiCD2 And mojiCD2 <= 57 Then
　　　　　　　　kaigyo = False
　　　　　　End If
　　　　End If

　　　　If kaigyo = True Then
　　　　　　elm1 = elm1 & vbLf
　　　　End If
　　　　TateGaki = TateGaki & elm1
　　Next
　　HankakuTategaki = TateGaki & Right(moji, 1)
End Function

お礼

どうしても・・・どうしても・・・うまく使いこなすことができません・・・。
あなた様に作っていただいたマクロで、うまく活用できないのはこれが初めて。
私の使い方が悪いと思うのですが・・・。
何が原因かさえ分りません・・・。
セルの書式は・・・のあたりかな？
もし心当たりがあったら、また書き込んでください。
お願いします・・・。

回答No.2

ARC

ありゃ、VBの質問でしたね。スイマセン。

えーっと、VBでするには、

○Wordオブジェクトを貼り付けて、そこで、縦中横表示をやってしまう(手間は省けそう、だが、Wordが必須)

○ピクチャーボックスを使って、そこにPrintメソッドで力技で文字を書く。(面倒くさそう。あらかじめ「升目」を計算しといて、そこに文字を当てはめていくようにすればいいかな。"123"の横幅とか、一文字の高さとかはTextWidth,TextHeightメソッドで算出する。)

ってなやり方を思いつきました。

不明点とかあったら、補足に書いていただくとそれなりに協力しますんで。

お礼

ごめんなさい。
勉強不足で、あなた様のおっしゃっていること自体が、イメージ湧きません。
興味があったのは、升目を計算しておいて…のところ。。。
いろんなやり方があるのですね！

実は…ＶＢで具体的に記述していただけると、「！！！」でした。
でも、目に止めていただいて、感謝感激です。
またお世話してください。
ありがとうございました。

回答No.1

ARC

[縦中横]を使います。
123を選択して、書式-拡張書式-縦中横
です。