Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel screen capture to capture cells and row and column headings | Excel Discussion (Misc queries) | |||
screen capture of page | Excel Worksheet Functions | |||
Screen shots capture | Excel Programming | |||
Need Help! VBA screen capture question | Excel Programming | |||
How to capture screen through VBA? | Excel Programming |