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

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