'将Excel中指定的Sheet中已使用的单元格截图,并保存为一个GIF图片。 Function createGIF(ByRef shSource As Excel.Worksheet, ByVal gifPath As String) Dim c As Chart Dim sh As Excel.Worksheet shSource.Select shSource.UsedRange.Select Application.ScreenUpdating = True '将可选区域截图,并保存到内存中剪贴板中。 Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 'sheet2 是一个临时sheet,也可以直接在当前workbook中新建一个,使用后删除。 'Set sh = ActiveWorkbook.Sheets("sheet2") '或者用以下代码新建一个临时sheet Set sh = ActiveWorkbook.Sheets.Add sh.Name = "access911.net" Dim s As Shape Dim p As Picture '将剪贴板中的图片粘贴到picture对象中 Set p = sh.Pictures.Paste '因为chart可以导出图像,所以新建一个临时图表控件 Set s = sh.Shapes.AddChart '设置图表控件的宽高于图片相等,否则图片可能变形或者有空白区域 s.Width = p.Width s.Height = p.Height '粘贴图片到图表中 s.Chart.Paste Debug.Print s.Chart.Shapes.Count If CLng(Application.Version) = 14 Then 'Excel 2010 用这部分 s.Chart.Shapes(1).Width = s.Width s.Chart.Shapes(1).Height = s.Height ElseIf CLng(Application.Version) = 12 Then 'Excel 2007 用这部分 s.Chart.Shapes(0).Width = s.Width s.Chart.Shapes(0).Height = s.Height End If 'p.Width = s.Width 'p.Height = s.Height '导出并保存为图片 s.Chart.Export gifPath '删除临时对象,为了避免EXCEL的提示,设置显示提示为否 Application.DisplayAlerts = False s.Delete p.Delete '删除 access911.net 临时 sheet sh.Delete '删除完毕后设置提示为是 Application.DisplayAlerts = True End Function '测试,将当前工作簿的sheet3截图,并保存为gif格式 Function RunTest() Dim sh As Excel.Worksheet Set sh = ActiveWorkbook.Sheets("sheet3") createGIF sh, ActiveWorkbook.Path & "\access911.net.gif" End Function |