Warning: file_get_contents(/data/phpspider/zhask/data//catemap/9/extjs/3.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel VBA在F8模式下工作,但不在F5模式下工作_Excel_Vba - Fatal编程技术网

Excel VBA在F8模式下工作,但不在F5模式下工作

Excel VBA在F8模式下工作,但不在F5模式下工作,excel,vba,Excel,Vba,我通读了几个关于同一个问题的线程,但它们似乎都有不同的解决方案,我无法将它们应用到我的代码中。我还使用Application.Wait(Time+TimeValue(“00:00:01”)和DoEvents在“导出”部分的所有行之间测试了代码 当我用F5运行代码时,会导出一张空白图片。当我用F8一步一步地运行它时,正确的图片被导出。当我用F8快速跳过时,它也不起作用。我试图找出哪一行不允许执行得太快,但失败了 编辑 在chartobj.Chart.Paste之前添加chartobj.Activa

我通读了几个关于同一个问题的线程,但它们似乎都有不同的解决方案,我无法将它们应用到我的代码中。我还使用
Application.Wait(Time+TimeValue(“00:00:01”)
DoEvents
在“导出”部分的所有行之间测试了代码

当我用F5运行代码时,会导出一张空白图片。当我用F8一步一步地运行它时,正确的图片被导出。当我用F8快速跳过时,它也不起作用。我试图找出哪一行不允许执行得太快,但失败了

编辑
chartobj.Chart.Paste之前添加
chartobj.Activate
帮助!


如果删除
Application.screenUpdate=False
,会发生什么?这对解决方案没有影响。请参见编辑。
Sub ExportSingleImage()
    'Plotplan Export Single Script v. 2.3

    Dim sheet, zoom_coef, area, chartobj
    Dim exportpath, prefix As String
    Dim sView, rr As String
    Dim xWs As Worksheet
    Dim leadingzeros As Boolean

    'Export Path (with trailing backslash)
    exportpath = ActiveWorkbook.Worksheets("Config").Range("B2")

    'Prefix
    prefix = ""

    'Tankstellennummern Länge
    idnumber_max = 6

    'Leading Zeros
    leadingzeros = False

    'Print Area
    rr = "B2:AI38"

    '------------------------------------------------------------------------------
    'Nothing to configure after here
    '------------------------------------------------------------------------------

    'Ask if existing files should be overwritten
    overwrite = MsgBox("Existierende Dateien überschreiben?", vbYesNoCancel)
    If overwrite = vbCancel Then
        Exit Sub
    End If

    Set xWs = ActiveWorkbook.ActiveSheet

    'Error when the sheetname is longer than the allowed max
    If Len(xWs.Name) > idnumber_max Then
        prompt = "Bezeichnung zu lang: " & xWs.Name & " (Maximal " & idnumber_max & " Stellen.)"
        MsgBox (prompt)
        Exit Sub
    End If

    'Check if export folder exists. If not, create it.
    If Dir(exportpath, vbDirectory) = "" Then
        MkDir exportpath
    End If

    'Assemble full path with filename
    If leadingzeros Then
        exportpath = exportpath & prefix & Right("000000" & xWs.Range("AJ47").Value, idnumber_max) _
            & " - " & xWs.Range("AJ43").Value & ".png"
    Else
        exportpath = exportpath & prefix & xWs.Range("AJ47").Value _
            & " - " & xWs.Range("AJ43").Value & ".png"
    End If

    'Check if file already exists or "overwrite" had been selected by the user
    If Dir(exportpath) = "" Or overwrite = vbYes Then

        ' -- EXPORT --

        'Captures current window view
        sView = ActiveWindow.View

        'Sets the current view to normal so there are no "Page X" overlays on the image
        ActiveWindow.View = xlNormalView

        'Temporarily disable screen updating
        Application.ScreenUpdating = False

        'Selection Print Area
        xWs.PageSetup.PrintArea = xWs.Range(rr).Resize(xWs.Range(rr).Rows.Count, xWs.Range(rr).Columns.Count).Address

        'Export print area as correctly scaled PNG image, courtasy of Winand
        'Lukasz: zoom_coef can be constant = 0 to 5 can work too, but save is 0 to 4

        zoom_coef = 2 '100 / sheet.Parent.Windows(1).Zoom

        Set area = xWs.Range(xWs.PageSetup.PrintArea)
        area.CopyPicture xlPrinter  'xlBitmap
        Set chartobj = xWs.ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
        chartobj.Chart.Paste
        chartobj.Chart.Export exportpath, "png"
        chartobj.Delete

        'Returns to the previous view
        ActiveWindow.View = sView

        'Re-enables screen updating
        Application.ScreenUpdating = True

    End If
End Sub