書面宏是指在保存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