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

龙行天下8888 · 发表于 2007-8-30 22:26

先知道有这功能

zhao08681 · 发表于 2007-8-30 22:42

不错，很方便

cgftzx · 发表于 2007-8-31 09:10

好得很,学习.版主的书更有用哦!

mxg825 · 发表于 2007-8-31 12:06

HYY514 · 发表于 2007-8-31 22:34

好代码，改进下，加进图片命名，可以在当前工作簿路径存一张以上图片。

Sub SheetOutJpg()
Dim Newshape As Shape, myname As String
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ActiveSheet.Paste
    myname = InputBox("请输入图片名字:")
     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 & "\" & myname & ".JPG"
         .Delete
     End With
     Newshape.Delete
   MsgBox "恭喜!图片已生成并存放在" & ActiveWorkbook.Path
End Sub

[此贴子已经被作者于2007-9-1 9:12:26编辑过]

lfspecter · 发表于 2007-9-10 12:05

试试先

zsd5237 · 发表于 2007-9-10 15:11

版主和HYY514都是好人，高手，区区几句代码，效果好似专业软件。

Alex · 发表于 2007-9-13 00:39

谢谢兰版分享

菡舞 · 发表于 2007-10-7 20:03

兰版高手^^

ABCCBA · 发表于 2007-10-8 05:56

兰大侠你的帖子我必看，受益匪浅。谢谢

		自动登录	找回密码
密码			注册

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