VBA - Metoda „add“ z diagramu objektů selhala

hlasů
1

Já jsem se snaží vytvořit funkci, která bude email část listu, s níže uvedený kód:

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

Jsem dočasně napevno rozsah chci snížit (i když by to neměl být problém ...), a dostanu chybu na tomto řádku:

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

Full error:

Run-time error'-2147417878 (80010108) ': Metoda 'Přidat' objektu 'ChartObjects' se nezdařilo

Mohl by mi někdo říct, kde moje chyba je? Aktualizováno kód:

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
Položena 19/09/2018 v 13:35
zdroj uživatelem
V jiných jazycích...                            


1 odpovědí

hlasů
1

Tyto proměnné nejsou explicitně deklarovány. Ačkoli to by neměl být problém tady, protože newChartje třeba zvážit Variant, se snaží psát Dim newChart as ChartObjectna lince předtím wbk.Activate.

Potom voláním samostatně něco tak malého, jako je tento:

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

A pak začít přidávat Plage.Left, Plage.Top, Plage.Width, Plage.Heightnamísto pevně zadanými argumenty (100). Pak přidáme wbk.Worksheets(Namesheet)stejně a uvidíme, jestli to funguje.


Není deklarování proměnných je opravdu špatná praxe. To funguje, pokud deklarovat všechny. V tomto konkrétním malý příklad, problém je nameRangeproměnná:

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

Jako další krok, zvažte čtení dokumentace pro Option Explicit:

Odpovězeno 19/09/2018 v 13:58
zdroj uživatelem

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