code giving very unexplicable error

Harvey

Well-known Member
Joined
Nov 18, 2004
Messages
953
hi

this is my code:
Code:
        For Each m_control In ActiveSheet.Shapes
            If m_control.BottomRightCell.Row = regelnr + 1 Then
                m_control.Delete
            End If
        Next m_control

this is the error:

-2147417848 (80010108)
Method Delete of object Shape failed.
error 440


It did never happen before. I haven't changed the code since yesterday when all worked perfect. This morning I ran this code several times and it worked. Suddenly (without me changing anything since yesterday) it came up with this error. Once at first. A couple of tries later, again. And now it gives this message on every go.

The only thing I found on this subject is that it's broken links in the code, but that is with very different code so it might not be that reason for me.

I'm not really sure if this is some fault of me or another Excel bug... ? :?
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
comboboxes, checkbox and textboxes. Some buttons also. All generated on the fly.

At first I thought the program did only crash when a certain combobox was deleted, but I found out it is a certain moment that the program is "going crazy" and raises errors with deleting any(all) shape, even when I use different code, or when I delete them in the debug window.
It is just behaving normal until it "crashes" could there be any other code involved that is triggering this, you think?
 
Upvote 0
this is the only code I "have to" run for the program to go crazy:

Code:
Function ArtikelEigenschappenVerwijderen()
    
    Dim artikel As String
    Dim regelnr As Integer
    Dim m_control As Shape
    
    artikel = Application.Caller
    regelnr = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Row - 1
    
    Debug.Print "caller verwijderen"
    On Error Resume Next
    ActiveSheet.Shapes(artikel).Delete
    Cells(regelnr, 1).EntireRow.Delete
    On Error GoTo 0
    Debug.Print "caller verwijderd"
    
    Do While Cells(regelnr, 3).Font.Bold = False And _
        regelnr <= Range("C65536").End(xlUp).Row
        Debug.Print "controls verwijderen"
        For Each m_control In ActiveSheet.Shapes
            If m_control.BottomRightCell.Row = regelnr + 1 Then
                Debug.Print "control : " & m_control.Name
                m_control.Delete
            End If
        Next m_control
        Debug.Print "controls verwijderd"
        Cells(regelnr, 1).EntireRow.Delete
    Loop
    
End Function

Function ArtikelEigenschappenToevoegen()

    Dim artikel As String
    Dim myEigenschap As Eigenschap
    Dim tmp As Range
    Dim kolom As Integer
    Dim i As Integer
    Dim paginanaam As String
    Dim regelnr As Integer
    
    EnableDoc (False)
    
    artikel = Application.Caller
    paginanaam = ActiveSheet.Name
    regelnr = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Row + 1
    
    Do While Cells(regelnr, 3).Interior.ColorIndex <> 20 And _
        regelnr <= Range("C65536").End(xlUp).Row + 1
        regelnr = regelnr + 1
    Loop
    
    ActiveSheet.Cells(regelnr, 1).EntireRow.Insert
    ActiveSheet.Cells(regelnr, 1).EntireRow.Insert
    ActiveSheet.Cells(regelnr, 1).EntireRow.Insert
    
    ActiveSheet.Cells(regelnr, 3).Value = _
        artikel & " " & GeefAantalArtikelenVanSoort(artikel) + 1
    ActiveSheet.Cells(regelnr, 3).Font.Bold = True
            
    With ActiveSheet.Buttons.Add(194, (regelnr) * 12.75 - 5, 13, 13)
        .Characters.Text = "-"
        .Name = artikel & "-"
        .OnAction = "ArtikelEigenschappenVerwijderen"
    End With
    
    regelnr = regelnr + 2
    
    
    Workbooks(bestandsnaam_beheer).Activate
    Sheets("artikelen").Activate
    
    'Zoekt in de lijst van artikelen de juiste op.
    Set tmp = Range(Cells(3, 2), Cells(3, _
        WorksheetFunction.CountIf(Sheets("artikelen").Range("3:3"), "*") + 1) _
        ).Find(artikel).Cells
    
    If IsNull(tmp) Then
        Error (1)
        'Klap er uit!
    Else
        kolom = tmp.Column
    End If

    'Ga alle eigenschappen bij langs
    For i = 4 To (Sheets("Eigensch. artikelen").Cells(3, 1).Value * 2) + 3 Step 2
        
        'Is het selectievakje op deze regel aangevinkt?
        If Cells(i, kolom).Value = True Then
            
            'Eigenschap ophalen
            Set myEigenschap = ArtikelEigenschapOphalen((i / 2) - 1)
            
            'Eigenschap weergeven
            regelnr = regelnr + ArtikelEigenschapWeergeven(myEigenschap:=myEigenschap, regelnr:=regelnr, paginanaam:=paginanaam, eigenschapkolom:=(i / 2))
            
            Workbooks(bestandsnaam_beheer).Sheets("artikelen").Activate
            'Set myeigenschap = InstallatieonderdeelEigenschapOphalen(i - 4)
            
        End If
    
    Next
    
    Workbooks(bestandsnaam_offerte).Activate
    EnableDoc (True)

End Function

theyre calling this functions:

Code:
Function ArtikelEigenschapWeergeven(myEigenschap As Eigenschap, regelnr As Integer, paginanaam As String, eigenschapkolom As Integer) As Integer

    Workbooks(bestandsnaam_offerte).Sheets(paginanaam).Activate
    
    ActiveSheet.Cells(regelnr, 1).EntireRow.Insert
    ActiveSheet.Cells(regelnr, 1).EntireRow.Insert
    
    Cells(regelnr, 3).Value = myEigenschap.Name
    Select Case myEigenschap.GetEigenschapType

        Case "Keuzelijst"

            MaakKeuzelijst regelnr:=regelnr, eigenschapkolom:=eigenschapkolom, _
                myEigenschap:=myEigenschap, paginanaam:=paginanaam, beheerpagina:="eigensch. artikelen"
            
        Case "Selectievak"

            MaakSelectievak regelnr:=regelnr, eigenschapkolom:=eigenschapkolom, _
                myEigenschap:=myEigenschap, paginanaam:=paginanaam, beheerpagina:="eigensch. artikelen"
            
        Case "Tekst"

            MaakTekst regelnr:=regelnr, eigenschapkolom:=eigenschapkolom, _
                myEigenschap:=myEigenschap, paginanaam:=paginanaam, beheerpagina:="eigensch. artikelen"
            
        Case "Getal"
        
            MaakGetal regelnr:=regelnr, eigenschapkolom:=eigenschapkolom, _
                myEigenschap:=myEigenschap, paginanaam:=paginanaam, beheerpagina:="eigensch. artikelen"
            
    End Select
    
    ArtikelEigenschapWeergeven = 2

End Function

Function ArtikelEigenschapOphalen(nummer As Integer) As Eigenschap

    Dim kolom, i As Integer
    Dim obj As Object
    
    Set ArtikelEigenschapOphalen = New Eigenschap
    
    kolom = nummer + 1
    ArtikelEigenschapOphalen.Name = Sheets("Eigensch. Artikelen").Cells(2, kolom).Value
    ArtikelEigenschapOphalen.SetEigenschapType Sheets("Eigensch. Artikelen").Cells(3, kolom).Value
    
    If (ArtikelEigenschapOphalen.GetEigenschapType = "Keuzelijst") Then
    
        i = 6
        While Trim(Sheets("Eigensch. Artikelen").Cells(i, kolom).Value) <> "" And _
            IsEmpty(Sheets("Eigensch. Artikelen").Cells(i, kolom).Value) = False
        
            Dim mystring As String
            mystring = Sheets("Eigensch. Artikelen").Cells(i, kolom).Value
            
            'Controle op dubbele namen
            Set obj = ArtikelEigenschapOphalen.values.Item(mystring)
            If obj.Name = "NOTHING" Then
                ArtikelEigenschapOphalen.values.Add mystring
            End If
            
            i = i + 1
            
        Wend
    
    End If
    
End Function

sorry that the comments and varnames are in dutch.
The functions not mentioned are creating OLEObjects. The objects that are deleted after.
What it does is look in the external document for data corresponding with the article whereof the button is clicked, then makes a couple of comboboxes, textboxes and checkboxes for the article.
A '-' button is used to delete this controls after.
 
Upvote 0
I'm not sure if I solved it now, actually I did do nothing, except restarting pc and rerunning the workbooks about ten times. Last time I restarted and reran, the error stopped :-S :unsure: :confused:
Anyone has an idea of how such an error can start and end suddenly this way?
I have to make sure this kinds of things arent happening when the program is finished.
 
Upvote 0
I wonder if it's because you are using Functions instead of Subs. Generally Functions can only return values, not make changes to the Excel environment.
 
Upvote 0
Andrew Poulsom said:
I wonder if it's because you are using Functions instead of Subs. Generally Functions can only return values, not make changes to the Excel environment.

Is that really true, because I use functions for everything in my document, except for the controls (the need subs somehow) I never experienced any problems or difficulty with that before (though I am programming in Excel for only about a month now :LOL:)

[edit]
can't find any subject on this differences except for the return value part of the difference. MSDN doesnt say anything about it too.
[/edit]
 
Upvote 0
A function procedure cannot change the contents or format of any cell.

This is a false statement, because a function can alter any cell or object. I think what they ment to say is that it cannot change the contents of a cell or object when they are run from inside a cell (as a worksheet formula)

I say this because I have lots of functions altering cells, controls or anything in the excel environment, and I never had any trouble with that.

With respect to your authority and the fact that you are trying to help me, I think this is not the problem, unless someone can prove me wrong by showing how functions altering cell values will fail.

Anyway, I DO appreciate your help on this subject and other cases before, thanks to you and other gurus on this forum I learned to use the VBA language. Thanks (y)
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,020
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top