excel - 記述されたマクロは、セル VBA 2010 の値を保存する際に問題があることを示しており、可能であればパスワードを使用しないでください。

Question

アクティブなワークブックからファイルをコピーする/新しいシートを作成する/新しいシートに情報をコピーする/最初からコピーしていないため、画像をコピーするために戻る/セルの名前として保存するため、このコードを記述しようとしましたdate+ some text であるアクティブなワークブック シート (3) の C71。何が起こるかというと、画像のコピーが拒否され、ファイルとして保存されず、元のワークシートに画像の歪みが生じます。コードでは、新しいシートを再度選択し、セル参照で保存することに問題があります。それを修正する方法の手がかりはありますか？ご覧のとおり、これは書かれたコードではなく、登録されています。私はいくつかの助けを感謝します。

`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").Activateを参照することが重要であることがわかりました。それ以外の場合は、画像をコピーしていません。次に重要なことは、セルとして保存することを参照するときは、& と保存する他のコマンドの間にスペースを 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