书面宏是指在保存VBA 2010单元格值时不保存任何问题（如果可能的话）的问题

Question

我尝试编写此代码，原因是从活动工作簿中复制文件/创建新工作表/在新工作表上复制信息/返回复制图片（因为它不是第一次复制）/并保存为cel的名称活动工作簿表（3）的C71是日期+一些文本。 发生的情况是图像拒绝复制，它不会创建另存为文件+会使原始工作表出现图像失真。 在代码中，再次选择新的工作表+用cel ref保存存在问题。 有男孩子如何解决这个问题的线索吗？ 如您所见，这不是书面代码，而是注册的。 我会请一些帮助。

`ActiveWindow.SmallScroll Down:=-9
Range("A1:L71").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.DisplayZeros = False
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.SmallScroll Down:=36
ActiveSheet.HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1
ActiveWorkbook.Sheets(3).Activate
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Selection.Copy
wbProcess.Sheets(1).Activate
ActiveWindow.SmallScroll Down:=-48
Range("B2").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 41
Selection.ShapeRange.IncrementTop -14
ActiveWindow.SmallScroll Down:=-9
Range("C10").Select
ActiveWorkbook.ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Selection.ShapeRange.IncrementTop 8
Application.PrintCommunication = False
With ActiveSheet.PageSetup
    .PrintTitleRows = ""
    .PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = "SAMANVATTING PER NIVEAU + TOTAAL"
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.708661417322835)
    .RightMargin = Application.InchesToPoints(0.708661417322835)
    .TopMargin = Application.InchesToPoints(0.748031496062992)
    .BottomMargin = Application.InchesToPoints(0.748031496062992)
    .HeaderMargin = Application.InchesToPoints(0.31496062992126)
    .FooterMargin = Application.InchesToPoints(0.31496062992126)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlPortrait
    .Draft = False
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = 80
    .PrintErrors = xlPrintErrorsDisplayed
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .ScaleWithDocHeaderFooter = True``
    .AlignMarginsHeaderFooter = True
    .EvenPage.LeftHeader.Text = ""
    .EvenPage.CenterHeader.Text = ""
    .EvenPage.RightHeader.Text = ""
    .EvenPage.LeftFooter.Text = ""
    .EvenPage.CenterFooter.Text = ""
    .EvenPage.RightFooter.Text = ""
    .FirstPage.LeftHeader.Text = ""
    .FirstPage.CenterHeader.Text = ""
    .FirstPage.RightHeader.Text = ""
    .FirstPage.LeftFooter.Text = ""
    .FirstPage.CenterFooter.Text = ""
    .FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ChDir _
    "C:\Users\Path"
ActiveWorkbook.SaveAs Filename:= _
    "C:\Users\Path" & "OVERZICHT" & ("G71") & ."xls" _
    , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close

结束子

Answer 1

对于来此帖子并有相同问题的人，我想发表一个问题，我自己找到了解决方案，并且我愿意与遇到相同问题的其他人分享。 我了解到，重要的是要引用Windows（“ Map1”）。如果要重新打开正在处理的文件，请激活 ，否则请不要复制图片。 下一件重要的事情是，当您将另存为Cel时，必须确保在＆和其他命令之间仅输入1个空格来保存。 这是一个完美的工作！

Range("A1:M71").Select
Selection.copy
Workbooks.Add
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Windows("NAME FILE.xlsm").Activate
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Application.CutCopyMode = False
Selection.copy
Windows("Map1").Activate
Range("B2").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 37.2
Selection.ShapeRange.IncrementTop -6
Range("A1:M71").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$M$71"
ActiveWindow.DisplayZeros = False
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.SmallScroll Down:=42
ActiveSheet.HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1
ActiveWindow.Zoom = 70
ActiveWindow.Zoom = 80
ActiveWindow.SmallScroll Down:=-57
Application.PrintCommunication = False
With ActiveSheet.PageSetup
    .PrintTitleRows = ""
    .PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$M$71"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.708661417322835)
    .RightMargin = Application.InchesToPoints(0.708661417322835)
    .TopMargin = Application.InchesToPoints(0.748031496062992)
    .BottomMargin = Application.InchesToPoints(0.748031496062992)
    .HeaderMargin = Application.InchesToPoints(0.31496062992126)
    .FooterMargin = Application.InchesToPoints(0.31496062992126)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlPortrait
    .Draft = False
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = 54
    .PrintErrors = xlPrintErrorsDisplayed
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .ScaleWithDocHeaderFooter = True
    .AlignMarginsHeaderFooter = True
    .EvenPage.LeftHeader.Text = ""
    .EvenPage.CenterHeader.Text = ""
    .EvenPage.RightHeader.Text = ""
    .EvenPage.LeftFooter.Text = ""
    .EvenPage.CenterFooter.Text = "TEXT"
    .EvenPage.RightFooter.Text = ""
    .FirstPage.LeftHeader.Text = ""
    .FirstPage.CenterHeader.Text = ""
    .FirstPage.RightHeader.Text = ""
    .FirstPage.LeftFooter.Text = ""
    .FirstPage.CenterFooter.Text = ""
    .FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ActiveWindow.SmallScroll Down:=-9
ChDir _
    "C:\Users\Path"
ActiveWorkbook.SaveAs Filename:= _
    "C:\Users\Path\" & Range("D2").Value & ".xlsx" _
    , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub