オートシェイプをGif形式で貼り付けテスト

三角くじを作ってみよう

Step 3　オートシェイプをGif形式で貼り付けテスト

オートシェープに文字を入力し回転させた場合、図形は回転できますがテキストは回転できません。
その為、透明化できるGif画像に変換し貼り付けたいと思います。
ここではその貼り付け位置を指定して、うまくいくかテストを行います。
PasteSpecial Format:="図 (GIF)", Link:=False, DisplayAsIcon:=False で貼り付け後、
SetステートメントでObjectに代入し、Topプロパティ・Leftプロパティで位置を指定しています。
次にNameプロパティで名前をつけています。
名前は「kuji」＋連番にする予定です。
ここまで問題なく進行できています。

シート画面

	「くじ引き」シートの左10、上10の位置に前回コピーしたものを　PasteSpecial　でペーストしています。

シートコード
	下記のコードに変更してください。 '作成開始ボタン Private Sub CommandButton1_Click() Dim ln1 As Long Dim ln2 As Long ln1 = MyGetSuchi("C2") If ln1 <= 0 Or ln1 > 100 Then MsgBox "くじ枚数は1～100の範囲で入力してください。" Exit Sub End If ln2 = MyGetSuchi("C3") If ln2 < 0 Or ln2 > ln1 Then MsgBox "当たり枚数は,くじ枚数より少なくしてください。" Exit Sub End If Range("C2") = ln1 Range("C3") = ln2 'オートシェイプ作成 ExMakeShape 'シェイプの貼り付け ExPasteShape End Sub ' 下記のコードを追加してください。 Sub ExPasteShape() Dim tshape As Shape Sheets("くじ引き").Activate '貼り付け ActiveSheet.PasteSpecial Format:="図 (GIF)", Link:=False, DisplayAsIcon:=False Set tshape = Selection.ShapeRange(1) '位置変更 tshape.Left = 10 tshape.Top = 10 '名前を付ける tshape.Name = "kuji1" Set tshape = Nothing End Sub

Topへ