Excel vba截图不行，帮忙看下

wwjiao

首先说明，代码是在Excel  home上面找的不是原创，但是想在变成出了点问题，有大牛帮忙看下哪里出了问题，谢谢公司电脑没有办法发代码只能发图片了，软件的目的就是保存当前工作表的区域另存为图片，图片格式为当前日期

lujkhua

看见你凌晨3点多还在学习，值得佩服！不过再好的技术也需要健康的身体才能发挥，建议注意休息！
下面是将  已用区域  保存为图片：

1. Private Declare Function OpenClipboard Lib "User32" (ByVal hWnd As Long) As Long
   
2. Private Declare Function CloseClipboard Lib "User32" () As Long
   
3. Private Declare Function GetClipboardData Lib "User32" (ByVal uFormat As Long) As Long
   
4. Private Declare Function CopyEnhMetaFileA Lib "Gdi32" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
   
5. Private Declare Function DeleteEnhMetaFile Lib "Gdi32" (ByVal hdc As Long) As Long
   
6. Sub lujkhua()
   
7.     Dim picnm As String
   
8.     picnm = Application.GetSaveAsFilename("try1.jpg", "图片, *.jpg", , "请选择保存路径并键入文件名")
   
9.     ActiveSheet.UsedRange.CopyPicture
   
10.     OpenClipboard 0
    
11.     DeleteEnhMetaFile CopyEnhMetaFileA(GetClipboardData(14), picnm)
    
12.     CloseClipboard
    
13. End Sub

复制代码

wwjiao

学习是不分时间段的呀，想要研究个东西不懂，所以需要不停的去学习。
老是我需要以下的功能：
将指定区域（如B2：M15)，以图片形式（JPG），保存到指定目录（如D:\123）,以日期+时分秒命名（20180626222519.jpg）
下列的代码只能保存为表格里面设置好的时间，不能同步系统时间，而且保存的图片不是很清晰，麻烦老师帮忙修改下，谢谢，本人小白。
Range("B1:m15").Select
    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 & "\" & Cells(3, 17) & ".jpg"
         .Delete
     End With
     Newshape.Delete
End Sub

YZC51

请参考
Sub bctp()
    Range("B1:m15").Select
    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 & "\" & Format(Now, "yymmddhhmmss") & ".jpg"
        .Chart.Export ActiveWorkbook.Path & "\" & Format(Now, "yyyymmddhhmmss") & ".bmp"
        .Delete
    End With
    Newshape.Delete
End Sub