What is wrong with this code? Screen capture and export as image?
 

Fellow programmers,

I have written a code to screencapture my current desktop and paste
it as a chart object -- so that Excel can export what it
screencaptured. The code works -- it's just that the picture is really
tiny... any ideas? Below is my code -- your help is very much
appreciated!!! Thanks!


Option Explicit

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)



Private Sub CommandButton1_Click()

Call keybd_event(&H2C, 0, 0, 0)
ActiveSheet.Paste




Dim MyChart As String, MyPicture As String
Dim PicWidth As Long, PicHeight As Long

Application.ScreenUpdating = False

MyPicture = Selection.Name

With Selection
PicHeight = .ShapeRange.Height
PicWidth = .ShapeRange.Width
End With

UserForm1.TextBox1.Value = PicHeight
UserForm1.TextBox2.Value = PicWidth

Charts.Add
ActiveChart.Location Whe=xlLocationAsObject, Name:="Sheet1"
Selection.Border.LineStyle = 0
MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)

With ActiveSheet
With .Shapes(MyChart)
.Width = UserForm1.TextBox2.Value
.Height = UserForm1.TextBox1.Value
End With

.Shapes(MyPicture).Copy

With ActiveChart
.ChartArea.Select
.Paste
End With

.ChartObjects(1).Chart.Export Filename:="C:\MyPic.gif",
FilterName:="gif"
.Shapes(MyChart).Cut
End With

Application.ScreenUpdating = True

End Sub

What is wrong with this code? Screen capture and export as image?
 

Selection.Height and Selection.Width is the height and width of the first
cell in the selection. You need to do something like this

set FirstCell = Selection
set LastCell = Selection.SpecialCells(xlCellTypeLastCell)

PicHeight = (LastCell.Top + LastCell.Height) - FirstCell.Top
PicWidth = (LastCell.Left + LastCell.Widcth) - FirstCell.Left



" wrote:

Fellow programmers,

I have written a code to screencapture my current desktop and paste
it as a chart object -- so that Excel can export what it
screencaptured. The code works -- it's just that the picture is really
tiny... any ideas? Below is my code -- your help is very much
appreciated!!! Thanks!


Option Explicit

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)



Private Sub CommandButton1_Click()

Call keybd_event(&H2C, 0, 0, 0)
ActiveSheet.Paste




Dim MyChart As String, MyPicture As String
Dim PicWidth As Long, PicHeight As Long

Application.ScreenUpdating = False

MyPicture = Selection.Name

With Selection
PicHeight = .ShapeRange.Height
PicWidth = .ShapeRange.Width
End With

UserForm1.TextBox1.Value = PicHeight
UserForm1.TextBox2.Value = PicWidth

Charts.Add
ActiveChart.Location Whe=xlLocationAsObject, Name:="Sheet1"
Selection.Border.LineStyle = 0
MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)

With ActiveSheet
With .Shapes(MyChart)
.Width = UserForm1.TextBox2.Value
.Height = UserForm1.TextBox1.Value
End With

.Shapes(MyPicture).Copy

With ActiveChart
.ChartArea.Select
.Paste
End With

.ChartObjects(1).Chart.Export Filename:="C:\MyPic.gif",
FilterName:="gif"
.Shapes(MyChart).Cut
End With

Application.ScreenUpdating = True

End Sub