Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4412 / 13644 ツリー ←次へ | 前へ→

【56801】オートシェイプ内の文字がずれるのは? koku 08/7/6(日) 2:11 質問[未読]
【56805】Re:オートシェイプ内の文字がずれるのは? ねむり猫 08/7/6(日) 7:41 回答[未読]
【56809】Re:オートシェイプ内の文字がずれるのは? kanabun 08/7/6(日) 14:22 発言[未読]
【56813】Re:オートシェイプ内の文字がずれるのは? koku 08/7/6(日) 23:02 お礼[未読]

【56801】オートシェイプ内の文字がずれるのは?
質問  koku  - 08/7/6(日) 2:11 -

引用なし
パスワード
   こんにちは。他のシートから抽出した値をオートシェイプ内にて下記のイメージ
で簡単な作表を試みました。
    195    52    36    26    39
   1654    201    632    101    296
SPACE関数にて文字の桁数に応じてスペースを作り、均等配置となるようにしたつもりですが結果はずれてしまいました。以下がそのコードです。


Sub test()
Dim Rng As Range
Set Rng = Range("B6:Z8")
  'オートシェイプの作成
  With ActiveSheet.Range("B6:Z8")
    Set tshape = ActiveSheet.Shapes.AddShape _(Type:=msoShapeFoldedCorner, Left:=Rng.Left, Top:=Rng. _
Top, Width:=Rng.Width, Height:=Rng.Height)
  End With
  '名前を付ける
  tshape.Name = "シェイプ01"


Dim 出桁数(1 To 8) As Integer
Dim 在庫桁数(1 To 8) As Integer
Dim 出荷数(1 To 8) As String
Dim 在庫数(1 To 8) As String
Dim TEXT(1 To 8) As String
Dim TEXT2(1 To 8) As String
Dim 列 As Integer

列 = 25
For i = 1 To 8
出荷数(i) = Sheets("3628").Cells(1 + i, 列).Value
在庫数(i) = Sheets("3628").Cells(1 + i, 列 + 1).Value

出桁数(i) = Len(出荷数(i))
在庫桁数(i) = Len(在庫数(i))

TEXT(i) = Space(10 - 出桁数(i))
TEXT2(i) = Space(10 - 在庫桁数(i))

Next
ActiveSheet.Shapes("シェイプ01").TextFrame.Characters.TEXT = TEXT(1) _
& 出荷数(1) & TEXT(2) & 出荷数(2) & TEXT(3) & 出荷数(3) & TEXT(4) _
& 出荷数(4) & TEXT(5) & 出荷数(5) & vbCrLf _
& TEXT2(1) & 在庫数(1) & TEXT2(2) & 在庫数(2) & TEXT2(3) & 在庫数(3) _
& TEXT2(4) & 在庫数(4) & TEXT2(5) & 在庫数(5)
  ActiveSheet.Shapes("シェイプ01").TextFrame.Characters.Font.Size = 12
   '垂直方向の位置
ActiveSheet.Shapes("シェイプ01").TextFrame.VerticalAlignment _
= xlVAlignBottom
  '水平方向の位置
  ActiveSheet.Shapes("シェイプ01").TextFrame.HorizontalAlignment _
= xlHAlignLeft
End Sub

初心者ゆえ原因を掴みかねており、かなり立ち止まっております。
1桁前後のずれならかまわないのですが状況しだいでは最後は3桁程度もずれてしまい非常に見づらいです。何かアドバイスをよろしくお願いいたします。

【56805】Re:オートシェイプ内の文字がずれるのは?
回答  ねむり猫  - 08/7/6(日) 7:41 -

引用なし
パスワード
   プロポーショナルfontのままになっているためでしょう。

ここへ下の2行目を追加してみてください。
'ActiveSheet.Shapes("シェイプ01").TextFrame.Characters.Font.Size = 12
ActiveSheet.Shapes("シェイプ01").TextFrame.Characters.Font.Name = "MS 明朝"


【56809】Re:オートシェイプ内の文字がずれるのは?
発言  kanabun  - 08/7/6(日) 14:22 -

引用なし
パスワード
   ▼koku さん:
>1桁前後のずれならかまわないのですが状況しだいでは最後は3桁程度もずれてしまい非常に見づらいです。

については、ねむり猫さんのアドバイスのとおり、固定ピッチフォントの使用で
解決ですね (^^

あと、指定カラムに文字列を整列させていく方法ですが、
Midステートメントを使うと速いです。

Sub 例1()
 Dim mySht As Worksheet
 Dim data
 Dim TextBox1 As Shape
 Dim i&, j&, m&, n&, ss$(), s$
 Dim 段数 As Long, 列数 As Long
 
 列数 = 8
 Set mySht = ActiveSheet
 data = mySht.[Y2:Z2].Resize(列数).Value
 段数 = UBound(data, 2)

 ReDim ss(1 To 段数)
 For i = 1 To 段数
   ss(i) = Space$(10 * 列数)
   For j = 1 To 列数
     s = data(j, i)
     n = Len(s)
     m = (j - 1) * 10 + 11 - n
     Mid$(ss(i), m, n) = s
   Next
 Next
 With mySht.Range("B6").Resize(段数 + 1, 列数 + 3)
   Set TextBox1 = mySht.Shapes.AddShape _
     (msoShapeFoldedCorner, .Left, .Top, .Width, .Height)
 End With
 With TextBox1.TextFrame.Characters
   .Font.Name = "MS ゴシック"
   .Font.Size = 12
   .Text = Join(ss, vbCrLf)
   .Parent.HorizontalAlignment = xlHAlignLeft
 End With
  
End Sub

【56813】Re:オートシェイプ内の文字がずれるのは?
お礼  koku  - 08/7/6(日) 23:02 -

引用なし
パスワード
   ねむり猫様
早速のレスありがとうございました。
ご回答くださったコードにてばっちり解決です。
これで明日の仕事が楽しみです。ありがとうございました。

KNABUN様
私にはまだまだ難しいコードでまだ試していませんがこちらのほうが汎用性が高そうに思います。わたしのコードが印刷結果等、思わしくなければ早速ためさせていただくつもりです。わたしのいたらぬ質問にこれほど立派なご回答をくださり感激しております。ありがとうございました。

4412 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free