六合开奖结果现场直播欢迎诸位!收藏本站注 册登 陆
常用三肖中特马:基础知识网络知识操作系统WPS网页制作数据库算法网页成功之路网络安全最新技术古典mid流行midmid背景下载中心
您现在的位置:首页 > 三肖中特马 > 文章页

将Excel选定的数据区域导出为图片的VBA代码

Admin | 2008-5-11 12:57:01 | ReadNums | 10762 | 标签 六合开奖结果现场直播 | 打印本页
     

  这种功能应用较广泛,本站通过网络搜集到相关代码,与大家一起分享,版权归原作者所有!

  要想实现这种功能,得使用VBA代码;

  首先通过EXCEL窗口,打开Microsoft Visual Basic窗口,建立如下图的用户窗体,相关控件请根据下图自行设计;


  此文针对有一定基础的网友,与此文相关的基础知识本站亦有文章说明,不再阐述!

  以下为VBA源代码:

===代码开始===

Private Sub CommandButton1_Click()

'代码文章来源网络
Dim FileSaveName As Variant
Dim ExportRange As Range
Dim strFileFilter As String
Dim ExportFormat As String
On Error GoTo 0
'消除所有图表对象,获得要保存的文件名
ActiveSheet.ChartObjects.Delete
strFileFilter = "GIF (*.gif),*.gif,JPEG (*.jpg),*.jpg,PNG (*.png),*.png"
FileSaveName = Application.GetSaveAsFilename(InitialFileName:=Range("E8"), FileFilter:=strFileFilter, FilterIndex:=Fileformat.ActiveControl.TabIndex + 1, Title:="图片保存为")
'如果文件名为空则退出,文件已经存在就删除旧文件
If FileSaveName = False Then Exit Sub
If Dir(FileSaveName) <> "" Then Kill FileSaveName
ExportFormat = UCase(Right(FileSaveName, 3))
'设定要导出图片的区域
Set ExportRange = Range("A1:E8")
'设定要复制的方法
CopyFormat.SetFocus
Select Case CopyFormat.ActiveControl.TabIndex
    Case 0
    ExportRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Case 1
    ExportRange.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
End Select
'新增图表于SHEET1以存放复制图像,并设置图表的填充色/边框为空
    Charts.Add
    With ActiveChart
        .ChartType = xlColumnClustered
        .Location Where:=xlLocationAsObject, Name:="Sheet1"
    End With
    With Selection
        .Border.LineStyle = 0
        .Interior.ColorIndex = xlNone
    End With
'贴图/导出图像/并删除刚刚建立的图表对象
    ActiveChart.Paste
    With ActiveSheet.Shapes(2)
    .Height = ExportRange.Height
    .Width = ExportRange.Width
    End With
    ActiveChart.Export Filename:=FileSaveName, FilterName:=ExportFormat
    ActiveSheet.ChartObjects.Delete
    Unload Me
    MsgBox "图片已保存到: " & FileSaveName
   
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

===代码结束===


问题未解决:在线咨询

网友评论

(访客)
内容实用原创,讲得很好。
20xx年x月x日
(站长)
有问题请在线咨询。
20xx年x月x日