Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Capture Screen to *.gif file via VBA Macro

Hi, Excel Expert

I'm Vidi from Bali, Indonesia
Just want to ask for help, please help me to discover my problems:

I want to capture screen with output file as *.gif (not excel file)
I have read some code. But the output file is not in *.gif file.
Thank you for helping me.

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default Capture Screen to *.gif file via VBA Macro

Try here at David McRitchie's site:
http://www.mvps.org/dmcritchie/excel/xl2gif.htm

--
Regards,
Tom Ogilvy

wrote in message
oups.com...
Hi, Excel Expert

I'm Vidi from Bali, Indonesia
Just want to ask for help, please help me to discover my problems:

I want to capture screen with output file as *.gif (not excel file)
I have read some code. But the output file is not in *.gif file.
Thank you for helping me.



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3
Default Capture Screen to *.gif file via VBA Macro

thanks
i have tried the link, many broken link.

i found topic "Make a GIF copy from a Clipboard Copy" but it also has a
broken link.
could you give me another help.

thank's for your attention

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default Capture Screen to *.gif file via VBA Macro

Link works fine for me. Here is the code.
---------------------------------------------------

The XL2GIF macro on this page was graciously supplied by Harald Staff


----------------------------------------------------------------------------
----
I thought I might add a little item to your "Save as HTML" stuff. This is a
little Excel8/9 routine that prompts for a worksheet range selection and
saves this as a GIF image. We use an extended version of this for
web-publishing some weekly reports. Limitations are the size of a bitmap
image copied in Excel, I guess it's a graphics limitation like "maximum
possible screen resolution" or something like that.
-- Harald Staff --

The subroutine to invoke is GIF_Snapshot to convert a range of cells to a
..GIF file.


Option Explicit
'Harold Staff -- see http://www.mvps.org/dmcritchie/excel/xl2gif.htm
'XL2GIF_module -- GIF_Snapshot
Dim container As Chart
Dim containerbok As Workbook
Dim Obnavn As String
Dim Sourcebok As Workbook

Function SelectArea() As String
Dim Internrange As Range
On Error GoTo Brutt
Set Internrange = Application.InputBox("Select " _
& "range to be photographed:", "Picture Selection", _
Selection.AddressLocal, Type:=8)
SelectArea = Internrange.Address
Exit Function
Brutt:
SelectArea = "A1"
End Function

Function sShortname(ByVal Orrginal As String) As String
Dim iii As Integer
sShortname = ""
For iii = 1 To Len(Orrginal)
If Mid(Orrginal, iii, 1) < " " Then _
sShortname = sShortname & Mid(Orrginal, iii, 1)
Next
End Function

Private Sub ImageContainer_init()
Workbooks.Add (1)
ActiveSheet.Name = "GIFcontainer"
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Worksheets(1).Range("A1")
ActiveChart.Location Whe=xlLocationAsObject, _
Name:="GIFcontainer"
ActiveChart.ChartArea.ClearContents
Set containerbok = ActiveWorkbook
Set container = ActiveChart
End Sub

Sub MakeAndSizeChart(ih As Integer, iv As Integer)
Dim Hincrease As Single
Dim Vincrease As Single
Obnavn = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
Hincrease = ih / ActiveChart.ChartArea.Height
ActiveSheet.Shapes(Obnavn).ScaleHeight Hincrease, _
msoFalse, msoScaleFromTopLeft
Vincrease = iv / ActiveChart.ChartArea.Width
ActiveSheet.Shapes(Obnavn).ScaleWidth Vincrease, _
msoFalse, msoScaleFromTopLeft
End Sub

Public Sub GIF_Snapshot()
Dim varReturn As Variant
Dim MyAddress As String
Dim SaveName As Variant
Dim MySuggest As String
Dim Hi As Integer
Dim Wi As Integer
Dim Suffiks As Long

Set Sourcebok = ActiveWorkbook
MySuggest = sShortname(ActiveSheet.Name)
ImageContainer_init
Sourcebok.Activate
MyAddress = SelectArea
If MyAddress < "A1" Then
SaveName = Application.GetSaveAsFilename( _
initialfilename: =MySuggest _
& ".gif", fileFilter:="Gif Files (*.gif), *.gif")
Range(MyAddress).Select
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
If SaveName = False Then
GoTo Avbryt
End If
If InStr(SaveName, ".") Then SaveName _
= Left(SaveName, InStr(SaveName, ".") - 1)
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
Hi = Selection.Height + 4 'adjustment for gridlines
Wi = Selection.Width + 6 'adjustment for gridlines
containerbok.Activate
ActiveSheet.ChartObjects(1).Activate
MakeAndSizeChart ih:=Hi, iv:=Wi
ActiveChart.Paste
ActiveChart.Export Filename:=LCase(SaveName) & _
".gif", FilterName:="GIF"
ActiveChart.Pictures(1).Delete
Sourcebok.Activate
End If
Avbryt:
On Error Resume Next
Application.StatusBar = False
containerbok.Saved = True
containerbok.Close
End Sub
-- Regards,Tom Ogilvy"vidi" wrote in message
oups.com...
thanks
i have tried the link, many broken link.

i found topic "Make a GIF copy from a Clipboard Copy" but it also has a
broken link.
could you give me another help.

thank's for your attention



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel screen capture to capture cells and row and column headings jayray Excel Discussion (Misc queries) 5 November 2nd 07 11:01 PM
screen capture of page Juco Excel Worksheet Functions 2 March 13th 05 12:50 AM
Screen shots capture matt dunbar Excel Programming 2 October 8th 04 03:03 PM
Need Help! VBA screen capture question Jon Peltier[_8_] Excel Programming 0 July 29th 04 11:40 PM
How to capture screen through VBA? Bill Choy[_2_] Excel Programming 3 July 23rd 04 05:00 AM


All times are GMT +1. The time now is 09:11 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"