| |
初めて質問＆VBAを作ってみたのですが、解らない所があるので質問させていただきます。
状況
・エクセルのシートにデータベースのように項目別に数値が並んでいる状態。
・Ｆ〜Iの列に入力されている数値をオートシェイプの幅と位置の数値に指定したい。
・1行につき、1つのオートシェイプを作製して入力されていない所まで繰り返し処理を行いたい。
これらを行いたく、以下のようなVBAを作ってみたのですが、うまく動いてくれません。オートシェイプの幅と位置情報が全て同じになってしまいます。
どこが悪いのかわからない状況です。どなたかご教授お願いいたします。
Sub AA()
Dim YOKOHABA As Long
Dim TATEHABA As Long
Dim YOKO As Long
Dim TATE As Long
Range("A2").Select
YOKOHABA = ActiveCell.Offset(0, 5).Value
TATEHABA = ActiveCell.Offset(0, 6).Value
YOKO = ActiveCell.Offset(0, 7).Value
TATE = ActiveCell.Offset(0, 8).Value
Do Until ActiveCell.Value = ""
ActiveSheet.Shapes.AddShape(msoShapeRectangle, YOKOHABA, TATEHABA, YOKO, TATE).Select
Selection.Characters.Text = _
ActiveCell.Offset(0, 0) & Chr(10) & ActiveCell.Offset(0, 1) & Chr(10) & ActiveCell.Offset(0, 2) & Chr(10) & ActiveCell.Offset(0, 3) & Chr(10) & ""
With Selection.Characters(START:=1, Length:=58).Font
.Name = "ＭＳ Ｐゴシック"
.FontStyle = "標準"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(1, 0).Select
Loop
End Sub
|
|
AA
- 10/8/5(木) 19:23 -
