| |
はじめまして。
初心者ながら、ＶＢＡに挑戦しているのですが、
どうにも解決できない問題があり、ご質問いたしました。
よろしくお願いします。
【作りたいソフト】
お絵かきソフト
【機能】
１ ＶＢＡでデスクトップのキャプチャを取得
２ 取得したキャプチャ画像をシートに貼り付け
３ キャプチャ画像を２と違うシートの背景に設定
４ その上にオートシェイプで、図形を描画
いろいろ調べて、下のようなコードを書きましたが、
機能３のキャプチャ画像をシートの背景にすることができません。
最初は機能２で貼り付けたキャプチャ画像を移動できないように
しようとしたのですが、shapeをenableにできずに断念し、画像を
背景にする方向を模索しております。
画像ファイルからではなく、クリップボードから設定したいと思い
No.52689のLindyさんのコードを参考にいたしましたが、うまく行きません。
うまくいかない部分は、＊＊＊で囲んだ部分です。
なにとぞ、ご教授をお願いいたします。
Sub main()
'-----------------------------------------------------------
' 変数定義
'
Dim str_ShpSnapshotName As String '（変数）スナップショットShapeの名称
Dim str_ShpBkupName As String
str_ShpSnapshotName = "Snapshot01" '「Snapshot01」を代入
str_ShpBkupName = "Bkup01" '「Bkup01」を代入
'-----------------------------------------------------------
' 初期処理（貼付対象シート・バックアップシートを事前にクリア）
'
On Error Resume Next 'Shapeが存在しない場合のエラー回避
ThisWorkbook.Worksheets("Bkup").Activate
Worksheets("Bkup").Shapes.SelectAll 'Shapeを全て選択
Selection.ShapeRange.Delete 'Shapeを全て消去
Worksheets("Bkup").Cells.Clear
Worksheets("Snap").Activate
Worksheets("Snap").Shapes.SelectAll
Selection.ShapeRange.Delete
Worksheets("Snap").Cells.Clear
On Error GoTo 0
'-----------------------------------------------------------
' 写込防止のため、Excelのウィンドウ最小化
'（３秒Wait）
'
Application.WindowState = xlMinimized
Application.Wait Now + TimeValue("00:00:03")
'-----------------------------------------------------------
' Snapshot取得
'
Application.ExecuteExcel4Macro "call(""user32"",""keybd_event"",""JJJJJ"",44,121,1,0)"
Application.ExecuteExcel4Macro "call(""user32"",""keybd_event"",""JJJJJ"",44,121,3,0)"
'-----------------------------------------------------------
' 「Bkup」シート・「Snap」シートにSnapshot画像をPaste
' Shape.Nameを「Bkup01」・「Snapshot01」に設定
' Excelウィンドウを全画面表示
'
ThisWorkbook.Worksheets("Bkup").Activate
Worksheets("Bkup").Range("a1").Select
Worksheets("Bkup").Paste
Worksheets("Bkup").Shapes(1).Name = str_ShpBkupName
Worksheets("Snap").Activate
'*************************************************************************
' クリップボードの画像を背景に設定（１枚のみ）
'
With Worksheets("Snap")
.Cells.ColumnWidth = 0.38
.Cells.RowHeight = 3.75
.SetBackgroundPicture Worksheets("Bkup").Shapes(str_ShpBkupName)
End With
'*************************************************************************
Application.Visible = True
Application.WindowState = xlMaximized
End Sub
|
|
すう
- 09/2/11(水) 8:59 -
