兰色原创：工作表中选取区域另存为图片的代码

兰色幻想

   看到论坛上有会员提问如何把工作表区域另存为图片，兰色研究了一个小时，终于把代码完成，希望大家喜欢。

Sub SheetOutJpg()
Dim Newshape As Shape
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ActiveSheet.Paste
     Set Newshape = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
     With ActiveSheet.ChartObjects.Add(1, 1, 1, 1)
         .Width = Newshape.Width
         .Height = Newshape.Height
          Newshape.Copy
         .Chart.Paste
         .Chart.Export ActiveWorkbook.Path & "\Myjpg.jpg"
         .Delete
     End With
     Newshape.Delete
   MsgBox "恭喜!图片已生成并存放在" & ActiveWorkbook.Path
End Sub

仔仔

沙发

白海豚

再顶~!~

swordin

执行不了,中断如黄色部分

Sub SheetOutJpg()
Dim Newshape As Shape
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ActiveSheet.Paste
     Set Newshape = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
     With ActiveSheet.ChartObjects.Add(1, 1, 1, 1)
         .Width = Newshape.Width
         .Height = Newshape.Height
          Newshape.Copy
         .Chart.Paste
         .Chart.Export ActiveWorkbook.Path & "\Myjpg.jpg"
         .Delete
     End With
     Newshape.Delete
   MsgBox "恭喜!图片已生成并存放在" & ActiveWorkbook.Path
End Sub

ldy

我弄一个礼拜也弄不出来，加精不过分。[em02]

hxqzccct

先下载

  谢谢兰版

兰色幻想

QUOTE:

以下是引用swordin在2007-8-30 19:02:35的发言：

执行不了,中断如黄色部分

Sub SheetOutJpg()
Dim Newshape As Shape
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ActiveSheet.Paste
     Set Newshape = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
     With ActiveSheet.ChartObjects.Add(1, 1, 1, 1)
         .Width = Newshape.Width
         .Height = Newshape.Height
          Newshape.Copy
         .Chart.Paste
         .Chart.Export ActiveWorkbook.Path & "\Myjpg.jpg"
         .Delete
     End With
     Newshape.Delete
   MsgBox "恭喜!图片已生成并存放在" & ActiveWorkbook.Path
End Sub

提示什么错误啊,我这里没有问题

hxqzccct

刚刚试完

  我的也没问题

 

lgm19761004

谢谢.

hhzjxss

谢谢兰版，测试成功！

 

[此贴子已经被作者于2007-8-30 20:37:46编辑过]