Excel VBAで作成した図形をGif形式に変換し貼り付けテスト：三角くじを作ってみよう - Step3
VBAで作成した図形をCopyし、PasteSpecialメソッドで貼り付けを行います。
オートシェープに文字を入力し回転させた場合、図形は回転できますがテキストは回転できません。
その為、透明化できるGif画像に変換し貼り付けたいと思います。
ここではその貼り付け位置を指定して、うまくいくかテストを行います。
PasteSpecialメソッドのFormatでGIF形式を指定すれば貼り付けができます。
貼り付け後、SetステートメントでObjectに代入し、Topプロパティ・Leftプロパティで位置を指定しています。
次にNameプロパティで名前をつけています。
名前は「kuji」＋連番にする予定です。
ここまで問題なく進行できています。
シート画面
「くじ引き」シートの左10、上10の位置に前回コピーしたものを PasteSpecial でペーストしています。
シートのVBAコード
下記のVBAコードに変更してください。
'作成開始ボタン
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
下記のVBAコードを追加してください。
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
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
下記のVBAコードを追加してください。
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
■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します
Copyright (c) Excel-Excel ! All rights reserved