Metodo CopyPicture della classe intervallo non riuscito - a volte

Question

Ho un codice VBA che sto usando per copiare intervalli come immagine e incollarli in un grafico. Lo fa così posso salvarlo in un'immagine. Questo codice ha una percentuale di successo del 70% e, quando non funziona, emette l'errore "Metodo CopyPicture della classe intervallo fallito". Non capisco perché a volte può funzionare e, a volte, non significa che stia prendendo gli stessi input.

Qualcuno può aiutare?

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

Per quanto mi riguarda ho avuto problema simile e ho potuto risolverlo cambiando tra il xlScreen e xlPrinter in selectRange.CopyPicture

Spero che questo aiuta

Answer 2

ero alle prese con lo stesso problema di voi e io pensare non ha nulla a che fare con il nostro codice VBA o la mancanza di capacità di programmazione. L'errore è troppo casuale.

Inoltre, se dopo aver ricevuto il messaggio di errore, ho fatto clic su DEBUG e premuto F8 per continuare a eseguire il codice passo dopo passo, quindi sono stato in grado di saltare l'errore. Dopo la linea problematica, ho premuto F5 per continuare nella normale modalità di esecuzione.

Ovviamente, quanto sopra non è una soluzione ma non rivela nulla di sbagliato con la mia codifica.

Beh, ho fatto questo e ha funzionato per me:

prima di questa frase,

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

ho aggiunto questo:

rgToPic.Copy 'just for nothing 

e non ho mai hanno avuto l'errore CopyPicture di nuovo.

---

ricerca di questo problema in altri posti ho scoperto alcuni utenti sono stati in grado di saltare l'errore con l'introduzione di questa frase prima del metodo CopyPicture:

application.CutCopyMode=false 

Answer 3

Anche se questo è un vecchio post, forse questo aiuterà qualcuno. Ho sofferto per un problema simile da molto tempo. CopyPicture non riuscito (su alcuni computer più spesso di altri, ma difficile da replicare sul mio laptop) quando stavo copiando l'intervallo che conteneva un'immagine PNG incorporata. Falliva solo nella modalità Application.Visible=0, Application.Visible=1 funzionava correttamente (per la mia applicazione è obbligatorio eseguire Excel in modalità invisibile). Finalmente ho scoperto che posso riprodurre il problema al 100% delle volte quando viene eseguito su una VM con 1 CPU. La seguente soluzione è strana, ma sembra che risolva completamente il mio problema.

PNG incorporato è un Shape in termini di Excel API. Avevo solo bisogno di scorrere le forme (nemmeno facendo nulla) prima di chiamare CopyPicture:

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

Il mio risultato è in qualche modo simile a this solution, dove CopyPicture stava venendo a mancare su una serie di grafici.Nel loro caso, attivando la cartella di lavoro e la gamma stessa ha aiutato.

Ipotizzando, sembra plausibile che su un computer lento o pesantemente caricato, Excel esegua "l'elaborazione lenta" degli oggetti complessi in una pagina, ovvero non li rende finché non si accede in qualche modo all'oggetto. Un modo per forzare il rendering sembra essere eseguito nella modalità Visible=1. Un altro modo è di scorrere gli oggetti. In questo caso, si tratta di un bug dell'implementazione CopyPicture di Excel in cui non impone il rendering di oggetti complessi prima di provare a copiare. Quando il metodo di copia rileva che il rendering per l'intervallo di destinazione non è pronto, genera semplicemente un errore invece di forzare l'intervallo a eseguire il rendering. Bene, almeno questa è la mia teoria.

Answer 4

Di solito le persone tendono ad aggiungere application.screenupdating=false ovunque, come abitudine (e di solito è buono).

Ma in questo caso, Excel non può vedere l'intervallo (correttamente) e quindi non può copiarlo. Immagino che internaly faccia qualcosa per il suo funzionamento, ma a causa della cattiva programmazione o del ritardo di sorta, non funziona sempre.

Quindi, ho controllato che se si rimuove application.screenupdating=false appena prima del copypicture, funziona, (anche senza e meglio degli appunti chiari/Rg.copy/appearence = xlPrinter/solutions).

qui è un esempio di codice che utilizzo (con oltre protezione agains cattive copie):

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 

È possibile saltare le parti non è necessario (questo è un controllo, quando il pulsante di destra, le copie vanno nell'immagine di una etichetta su un modulo utente