VBA - Metoda „add” obiektów wykresu zawiodły

głosy
1

Ja próbuje utworzyć funkcję, która będzie Powiadom część arkusza z poniższym kodzie:

Function PictureToHTML(wbk, Namesheet, nameRange, imgFile)

    wbk.Activate
    Worksheets(Namesheet).Activate

    nameRange = C7:C10

    Set Plage = wbk.Worksheets(Namesheet).Range(nameRange)
    Plage.CopyPicture

    TempFilePath = Environ$(temp) & \ & imgFile

    Set newchart = wbk.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)

    With newchart
        .Activate
        .Chart.parent.Border.LineStyle = 0
        .Chart.Paste
        .Chart.Export TempFilePath, PNG
    End With
    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
    Set Plage = Nothing

    PictureToHTML = <br><B> & Namesheet & :</B><br> _
                & <img src='cid: & imgFile & '>

End Function

Mam tymczasowo ustalony zakres chcę wyciąć (chociaż to nie powinno być problemem ...), i pojawia się błąd na tej linii:

Set newchart = wbk.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)

Pełna błąd:

Run-time error'-2147417878 (80010108) ': Metoda 'Dodaj' obiektu' ChartObjects Zmarnowana

Czy ktoś może mi powiedzieć, gdzie jest mój błąd? Zaktualizowany kod:

Function PictureToHTML(wbk, Namesheet, nameRange, imgFile)

    Dim WeightsSheet As Worksheet
    Dim newChart As ChartObject
    wbk.Activate

    Set WeightsSheet = wbk.Worksheets(Namesheet)

    Set Plage = wbk.Worksheets(Namesheet).Range(nameRange)
    Plage.CopyPicture

    TempFilePath = Environ$(temp) & \ & imgFile
    Set newChart = WeightsSheet.ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)

    With newChart
        .Activate
        .Chart.parent.Border.LineStyle = 0
        .Chart.Paste
        .Chart.Export TempFilePath, PNG
    End With
    WeightsSheet.ChartObjects(WeightsSheet.ChartObjects.Count).Delete
    Set Plage = Nothing

    PictureToHTML = <br><B> & Namesheet & :</B><br> _
                & <img src='cid: & imgFile & '>

End Function
Utwórz 19/09/2018 o 13:35
źródło użytkownik
W innych językach...                            


1 odpowiedzi

głosy
1

Zmienne nie są jawnie zadeklarowana. Mimo to nie powinno być problemem, ponieważ newChartnależy uznać Variant, spróbuj napisać Dim newChart as ChartObjectna linii przed wbk.Activate.

Potem dzwoni osobno coś tak mały, jak ten:

Sub TestMe()
    Dim newChart As ChartObject
    Set newChart = Worksheets(1).ChartObjects.Add(100, 100, 100, 100)
End Sub

A następnie rozpocząć dodawanie Plage.Left, Plage.Top, Plage.Width, Plage.Heightzamiast zakodowanych argumentów (100). Następnie dodać wbk.Worksheets(Namesheet)także i sprawdzić, czy to działa.


Nie deklarowania zmiennych jest bardzo złą praktyką. To działa, jeśli deklarują wszystko. W tym konkretnym przykładzie małego, problem jest nameRangezmienna:

Option Explicit

Sub TestMe()
    Debug.Print PictureToHTML(ThisWorkbook, "Sheet1", Range("A1:E20"), "probably.png")
End Sub

Function PictureToHTML(wbk As Workbook, Namesheet As String, _
                        nameRange As Range, imgFile As String) As String

    Dim WeightsSheet As Worksheet
    Dim newChart As ChartObject
    Dim Plage As Range
    Dim tempFilePath As String

    Set WeightsSheet = wbk.Worksheets(Namesheet)

    Set Plage = wbk.Worksheets(Namesheet).Range(nameRange.Address)
    Plage.CopyPicture

    tempFilePath = Environ$("temp") & "\" & imgFile
    Set newChart = WeightsSheet.ChartObjects.Add( _
                        Plage.Left, Plage.Top, Plage.Width, Plage.Height)

    With newChart
        .Chart.Parent.Border.LineStyle = 0
        .Chart.Paste
        .Chart.Export tempFilePath, "PNG"
    End With

    WeightsSheet.ChartObjects(WeightsSheet.ChartObjects.Count).Delete
    PictureToHTML = "<br><B>" & Namesheet & ":</B><br>" & "<img src='cid:" & imgFile & "'>"

End Function

W następnym kroku, należy rozważyć czytanie dokumentacji Option Explicit:

Odpowiedział 19/09/2018 o 13:58
źródło użytkownik

Cookies help us deliver our services. By using our services, you agree to our use of cookies. Learn more