teacup. [ 掲示板 ] [ 掲示板作成 ] [ 有料掲示板 ] [ ブログ ]

 投稿者
  題名
  内容 入力補助画像・ファイル<IMG>タグが利用可能です。(詳細)
    
 URL
[ ケータイで使う ] [ BBSティッカー ] [ 書込み通知 ] [ 検索 ]

スレッド一覧

  1. 足あと帳(0)
スレッド一覧(全1)  他のスレッドを探す 

*掲示板をお持ちでない方へ、まずは掲示板を作成しましょう。無料掲示板作成


てすと

 投稿者:てすと  投稿日:2012年 9月25日(火)10時30分28秒 softbank126057086003.bbtec.net
返信・引用
  Sub A列の文字列のシェイプを一括作成()

    Dim shapeType As String
    Dim shapeW As Integer
    Dim shapeH As Integer
    Dim kaigyo As Integer

    Dim maxRow As Integer
    maxRow = Range("A2").End(xlDown).Row

    Dim myShape As Shape

    Dim rcode() As String 'シェイプ内の文字列その1
    ReDim rcode(maxRow)

    Dim shapeRow As Integer 'シェイプを作る行(縦位置)
    Dim shapeCol As Integer 'シェイプを作る列(横位置)
    Dim kaigyoCol As Integer 'シェイプを改行する高さ

    shapeCol = 280
    shapeRow = 120


    For i = 1 To maxRow

    kaigyoCol = ActiveSheet.Cells(i, 4).Value

        '=== シェイプの形と大きさを決めて下さい ここから ===
    shapeType = msoShapeRectangle 'シェイプの形
            '円なら msoShapeOval
            '四角なら msoShapeRectangle
            '角丸四角形なら msoShapeRoundedRectangle
            '吹き出しなら msoShapeBalloon
            '角丸四角吹き出しなら msoShapeRoundedRectangularCallout
             shapeW = 75             'シェイプの大きさ(横幅)
             shapeH = 25             'シェイプの大きさ(高さ)
             kaigyo = 5                     '何個おきに改行させるか

    '=== シェイプの形と大きさを決めて下さい ここまで ===


        'A列とB列の値を取得
        rcode(i) = ActiveSheet.Cells(i, 1).Value

        'シェイプを作る位置を決める。
        If i Mod kaigyo = 0 Then '何個おきに改行させるか。iの行数で除算
            shapeCol = 280
            shapeRow = shapeRow + kaigyoCol + 3
        End If


    'オートシェイプを作成する
    Set myShape = ActiveSheet.Shapes.AddShape(Type:=shapeType, _
        Left:=shapeCol, Top:=shapeRow, Width:=shapeW, Height:=shapeH)

    '文字列を入れる
    myShape.Select
    Selection.Characters.Text = rcode(i) 'A列のみ
    Selection.Characters.Font.Size = ActiveSheet.Cells(i, 2).Value 'フォントサイズ変更
    Selection.ShapeRange.TextFrame2.AutoSize = msoAutoSizeShapeToFitText 'フォントサイズに合わせる
    Selection.ShapeRange.TextFrame2.WordWrap = msoFalse 'フォントを折り返さない

    'Selection.Characters.Text = rcode(i) & vbCr & rtitle(i) 'A列&B列

      shapeCol = shapeCol + myShape.Width + 3

    Next

End Sub
 
 

掲示板が完成しましたキラキラ

 投稿者:teacup.運営  投稿日:2012年 9月25日(火)10時28分22秒 softbank126057086003.bbtec.net
返信・引用
  ご利用ありがとうございます。

teacup.掲示板は
ダイヤスレッド作り放題右上
ダイヤ画像・動画・音楽の投稿OK
ダイヤケータイ絵文字が使えるv▽v
ダイヤRSS対応ヒラメイタ!
ダイヤお絵描き機能付きえんぴつ
ダイヤかわいいケータイテンプレハートx2

足跡足あと帳はコチラ
スレッド内容は管理画面内「スレッドの管理」から編集できます。
 

レンタル掲示板
/1