Metoda klasy CopyPicture nie powiodła się - czasami

Question

Mam kod VBA, którego używam do kopiowania zakresów jako obraz i wklejania ich do wykresu. Czyni to, aby zapisać go w obrazie. Ten kod ma wskaźnik sukcesu równy 70%, a gdy nie działa, podaje błąd "Metoda CopyPicture klasy zakresu nie powiodła się". Nie rozumiem, dlaczego czasami może zadziałać, a czasami nie, biorąc pod uwagę to, że bierze te same dane wejściowe.

Czy ktoś może pomóc?

Public Sub ExportRange(workbookPath As String, sheetName As String, rangeString As String, savepath As String) 

    Set tempWorkBook = Workbooks.Open(workbookPath) 

    Dim selectRange As range 
    Set selectRange = Worksheets(sheetName).range(rangeString) 
    Dim numRows As Long 
    numRows = selectRange.Rows.Count 
    Dim numCols As Long 
    numCols = selectRange.Columns.Count 

    ' Transfer selection to a new sheet and autofit the columns 
    selectRange.Copy 
    Dim tempSheet As Worksheet 
    Set tempSheet = Sheets.Add 
    tempSheet.range("A1").PasteSpecial xlPasteAll 

    ActiveSheet.UsedRange.Columns.AutoFit 
    Set selectRange = ActiveSheet.UsedRange 
    selectRange.Select 
    selectRange.CopyPicture xlScreen, xlPicture 

    Dim tempSheet2 As Worksheet 
    Set tempSheet2 = Sheets.Add 
    Dim oChtobj As Excel.ChartObject 
    Set oChtobj = tempSheet2.ChartObjects.Add(_ 
     selectRange.Left, selectRange.Top, selectRange.Width, selectRange.Height) 

    Dim oCht As Excel.Chart 
    Set oCht = oChtobj.Chart 
    oCht.Paste 
    oCht.Export filename:=savepath 
    oChtobj.Delete 

    Application.DisplayAlerts = False 
    tempSheet.Delete 
    tempSheet2.Delete 
    tempWorkBook.Close 
    Application.DisplayAlerts = True 

End Sub 

Answer 1

Dla mnie miałem podobny problem i mogę go rozwiązać, zmieniając między xlScreen i xlPrinter w selectRange.CopyPicture

Mam nadzieję, że to pomoże

Answer 2

miałem problemy z tym samym numerze niż ty i ja myślenie nie ma nic wspólnego z naszym kodem VBA lub brakiem umiejętności programowania. Błąd jest zbyt losowy.

Co więcej, jeśli po otrzymaniu komunikatu o błędzie kliknąłem DEBUG i nacisnąłem F8, aby kontynuować wykonywanie kodu krok po kroku, wtedy mogłem pominąć błąd. Po problematycznej linii nacisnąłem F5, aby kontynuować w normalnym trybie wykonywania.

Oczywiście powyższe rozwiązanie nie jest rozwiązaniem, ale nie ujawnia niczego złego w moim kodowaniu.

Cóż, zrobiłem to i to działało na mnie:

przed tym zdaniu

rgToPic.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 

dodałam to jedno:

rgToPic.Copy 'just for nothing 

i nigdy nie miałem błąd w CopyPicture metoda ponownie.

---

Patrząc na ten temat w innych miejscach I okazało się, że niektórzy użytkownicy mogli pominąć błąd wprowadzając to zdanie przed metody CopyPicture:

application.CutCopyMode=false 

Answer 3

Chociaż jest to stary post, może to komuś pomoże. Przez długi czas zmagałem się z podobnym problemem. CopyPicture nie powiodło się (na niektórych komputerach częściej niż inne, ale trudne do replikacji na moim laptopie) podczas kopiowania zakresu, w którym zawierał osadzony obraz PNG. Udało się tylko w trybie Application.Visible=0, Application.Visible=1 zadziałało dobrze (dla mojej aplikacji uruchamianie programu Excel w trybie niewidocznym jest obowiązkowe). W końcu odkryłem, że mogę odtworzyć problem w 100% przypadków, gdy uruchamiany jest na maszynie wirtualnej z 1 procesorem. Poniższe rozwiązanie jest dziwne, ale wydaje się, że całkowicie rozwiązuje mój problem.

Wbudowany PNG to Shape w terminach interfejsu API programu Excel. I po prostu potrzebne, aby przejść przez kształtach (nawet nie robiąc nic) przed wywołaniem CopyPicture:

# 'rng' is a range that I want CopyPicture on 
for shape in rng.Shapes: pass 
rng.CopyPicture(xlScreen, xlBitmap) 

Moim odkryciem jest nieco podobna do this solution, gdzie CopyPicture została braku na szeregu z wykresami.W ich przypadku pomógł sam aktywujący skoroszyt i zakres.

Hipoteza: wydaje się prawdopodobne, że na powolnym lub mocno obciążonym komputerze Excel wykonuje "leniwą obróbkę" złożonych obiektów na stronie, tj. Nie renderuje ich, dopóki obiekt nie zostanie w jakiś sposób uzyskany. Jeden ze sposobów wymuszania renderowania wydaje się działać w trybie Visible=1. Innym sposobem jest przechodzenie między obiektami. W takim przypadku jest to błąd implementacji programu Excel w wersji CopyPicture, w której nie wymusza renderowania złożonych obiektów przed próbą skopiowania. Gdy metoda kopiowania dowiaduje się, że renderowanie dla zakresu docelowego nie jest gotowe, po prostu powoduje błąd, zamiast wymuszać renderowanie zakresu. Cóż, przynajmniej taka jest moja teoria.

Answer 4

Zwykle ludzie na ogół dodają application.screenupdating=false jako nawyk (i zazwyczaj jest to dobre).

Jednak w tym przypadku program Excel nie widzi zakresu (prawidłowo), a zatem nie może go skopiować. Domyślam się, że internaly robi coś dla niego, ale z powodu złego kodowania lub opóźnienia, to nie działa za każdym razem.

Sprawdziłem więc, że jeśli usuniesz application.screenupdating=false tuż przed copypicture, to działa, (nawet bez i lepiej niż jasne schowek/Rg.copy/appeight = xlPrinter/solutions).

tutaj jest exemple kodu używam (z nadmierną ochronę Agains złych kopii):

If Button = 2 And Eventz Then 
    Eventz = False 
    Cache_Souris 
    XX = X: YY = Y 
    sound "scroll1_short.wav" 
    Dim iPic2 As Object, Samerde As Boolean 
    With Lbl_CadreGothique.Parent 
     'With .Controls.add("Forms.Image.1", "Temp", False) 
     With .Controls("Temp") 
       .Top = Lbl_CadreGothique.Top + Y - 20 ': .Left = Lbl_CadreGothique.Left + X + 20 
       .BorderColor = 0: .BackColor = Lbl_TypeSkillTxt.ForeColor 
       .PictureAlignment = fmPictureAlignmentTopLeft 
       Err.Clear: On Error Resume Next 
       .AutoSize = True 
       Clear_Clipboard 
       'Rg.Copy 
       Rg.CopyPicture xlScreen, xlPicture 'xlBitmap 
       If Err = 0 Then 
        Set iPic2 = PastePicture '(xlBitmap) 
        If Not iPic2 Is Nothing Then 
          .Picture = iPic2 
        Else 
          Rg.CopyPicture xlScreen, xlBitmap: 
          Set iPic2 = PastePicture(xlBitmap) 
          If Not iPic2 Is Nothing Then 
           .Picture = iPic2 
          Else: Rg.CopyPicture xlPrinter, xlBitmap: .Picture = PastePicture(xlBitmap) 
          End If 
        End If 
        Set iPic2 = Nothing 
       Else 
        Rg.CopyPicture xlScreen, xlBitmap: .Picture = PastePicture(xlBitmap) 
       End If 
       Err.Clear: On Error GoTo 0 
       .AutoSize = False 

       If .Width > Rg.Width Then .Width = Rg.Width: Samerde = True 

       If Lbl_CadreGothique.Left + Lbl_CadreGothique.Width + X + 100 < .Parent.InsideWidth Then 
        .Left = Lbl_CadreGothique.Left + X + 20 
       Else: .Left = Lbl_CadreGothique.Left + X - 10 - .Width 
       End If 


       If .Height > Rg.Height Then .Height = Rg.Height: Samerde = True 
       'si marche pas mettre picture ? 
       If Samerde Then 
        .PictureSizeMode = fmPictureSizeModeStretch 
       Else: .PictureSizeMode = fmPictureSizeModeClip 
       End If 
       .Top = Min2(.Top, .Parent.InsideHeight - .Height) 
       .ZOrder 0 
       Application.ScreenUpdating = False 
       .Visible = True 
       DoEvents 
       'Debug.Print Rg.Width, .Width 
     End With 
    End With 
    aff_souris 
    Calc_ON 
    Eventz = True 
End If 

Można pominąć części nie trzeba (to jedno jest kontrola, gdy prawy przycisk, kopiuje zakres na obraz etykiety na formularzu użytkownika