OKWAVEのAI「あい」が美容・健康の悩みに最適な回答をご提案!
-PR-
解決
済み

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

  • すぐに回答を!
  • 質問No.111864
  • 閲覧数507
  • ありがとう数9
  • 気になる数0
  • 回答数7
  • コメント数0

お礼率 67% (35/52)

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

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

 こ
 れ
 は
 123
 円
 で
 す

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

具体的に記述して教えていただけると、ありがたいです。
かなりワガママですが、コメントを入れてください・・・
お願いします。
通報する
  • 回答数7
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.7
レベル13

ベストアンサー率 68% (791/1163)

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

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

より自然に見えるようにしてみました。(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 '前後の1文字と書き出す文字
  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
お礼コメント
iillyy

お礼率 67% (35/52)

これで十分です。
本当にありがとうございました。
アナタのような方は、本当に貴重です。
また見かけたらお世話してください。
投稿日時 - 2001-08-28 13:05:25
-PR-
-PR-

その他の回答 (全6件)

  • 回答No.2
レベル13

ベストアンサー率 46% (643/1383)

ありゃ、VBの質問でしたね。スイマセン。 えーっと、VBでするには、 ○Wordオブジェクトを貼り付けて、そこで、縦中横表示をやってしまう(手間は省けそう、だが、Wordが必須) ○ピクチャーボックスを使って、そこにPrintメソッドで力技で文字を書く。(面倒くさそう。あらかじめ「升目」を計算しといて、そこに文字を当てはめていくようにすればいいかな。"123"の横幅と ...続きを読む
ありゃ、VBの質問でしたね。スイマセン。

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

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

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

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

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

お礼率 67% (35/52)

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

実は…VBで具体的に記述していただけると、「!!!」でした。
でも、目に止めていただいて、感謝感激です。
またお世話してください。
ありがとうございました。
投稿日時 - 2001-08-05 15:32:15


  • 回答No.1
レベル13

ベストアンサー率 46% (643/1383)

[縦中横]を使います。 123を選択して、書式-拡張書式-縦中横 です。
[縦中横]を使います。
123を選択して、書式-拡張書式-縦中横
です。
  • 回答No.3
レベル13

ベストアンサー率 68% (791/1163)

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

標準モジュールに貼り付けて下さい。
Public Function HankakuYokogaki(moji As String)
  Dim L As Integer 'カウンタ
  Dim elm1, elm2 As String '1文字
  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
お礼コメント
iillyy

お礼率 67% (35/52)

どうしても・・・どうしても・・・うまく使いこなすことができません・・・。
あなた様に作っていただいたマクロで、うまく活用できないのはこれが初めて。
私の使い方が悪いと思うのですが・・・。
何が原因かさえ分りません・・・。
セルの書式は・・・のあたりかな?
もし心当たりがあったら、また書き込んでください。
お願いします・・・。
投稿日時 - 2001-08-15 13:31:51
  • 回答No.4
レベル13

ベストアンサー率 68% (791/1163)

最後から2行目を書き換えて下さい。回答文書を記入中に関数名を変えてしまいました。   HankakuTategaki = TateGaki & Right(moji, 1)      ↓   HankakuYokogaki = TateGaki & Right(moji, 1)
最後から2行目を書き換えて下さい。回答文書を記入中に関数名を変えてしまいました。

  HankakuTategaki = TateGaki & Right(moji, 1)
     ↓
  HankakuYokogaki = TateGaki & Right(moji, 1)
  • 回答No.5
レベル13

ベストアンサー率 46% (643/1383)

>実は…VBで具体的に記述していただけると、「!!!」でした。 ちょっと時間が空いたんで、実際に作ってみました。 フォームにピクチャボックス(Picture1),テキストボックス(Text1),ボタン(縦書きボタン)を配置して、以下のようにコーディングしてください。 Picture1のAutoRedrawはTrueに設定しときます。 テキスト中の$H(文字列)を縦中横表示し ...続きを読む
>実は…VBで具体的に記述していただけると、「!!!」でした。

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


フォームにピクチャボックス(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 '字を書く座標(xは行の中心線)
 Dim StPos As Long, EdPos As Long '文字列内の位置情報
 Text = Me.Text1
 
 Me.Picture1.Cls
 Me.Picture1.FontName = "MS ゴシック"
 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
お礼コメント
iillyy

お礼率 67% (35/52)

あまりにもご丁寧で・・・感激→ダウン気味(笑)
ありがとうございました。
投稿日時 - 2001-08-15 13:28:51
  • 回答No.6
レベル13

ベストアンサー率 68% (791/1163)

>どうしても・・・どうしても・・・うまく使いこなすことができません・・・。 まず、ANo.#3は一部誤りがあったのでANo.#4の修正をお願いします。  =HankakuYokogaki(今ある算式) をセットしたセルの書式は、  (1)折り返して全体を表示する(配置タグ)  (2)方向は横書き(分度器みたいに見えるほうで0度。初期値です)  (3)セルの高さは全体が表示できる高さに増 ...続きを読む
>どうしても・・・どうしても・・・うまく使いこなすことができません・・・。

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

とします。エラー表示が出るのであれば補足してください。
お礼コメント
iillyy

お礼率 67% (35/52)

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

ところで、リンク元に「。」や「、」があると、見た感じ、ヘンですね(笑)。
何か解決策はありますか?
もう本当に贅沢すぎ。。。
今後も知恵を貸してくださいね。
投稿日時 - 2001-08-22 10:22:21
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
こんな書き方もあるよ!この情報は知ってる?あなたの知識を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ