none
Run-Time error 1004 RRS feed

  • Pergunta

  • Boas,

     Preciso de ajuda : No excel 2003 funciona mas em 2007 não. Abro o ficheiro, escolho o caminho para outro ficheiro no sentido de importar um desenho, depois ao clicar no botão para importar dá o erro run-time "Não é possível definir a propriedade Formula da classe TextBox" :

     O código do botão que importa o desenho :

            

    Sub Load_ApprovalDwg_Button_Click()

        'On Error GoTo handler
        'Constants
        Dim libname, libpathname As String

        With Application
            .DisplayAlerts = False
            .ScreenUpdating = False
            If Not DEBUGMODE Then .Interactive = False
        End With

        libname = "ApprovalDrawingLibrary.xls"
        libpathname = ThisWorkbook.Sheets(CONSTANTS_SHEET).Range("LibraryLocation") & Application.PathSeparator & libname

        If LoadDrawing("Approval Dwg", libpathname) Then
            'HandrailBoltHoles
            ApprovalDrawStair
            positionHandrailApproval
            ApprovalDeleteHoles
            DoNotching
            DoCutProfile
            DoApprovalConcrete
            DoApprovalOBR
        End If

        With Application
            .DisplayAlerts = True
            .ScreenUpdating = True
            .Interactive = True
        End With
        Exit Sub
    handler:
        MsgBox "Unexpected error when loading Approval Drawing"
    End Sub

     O código da função onde está o erro :

    Sub UpdateDrawingLinks(apr As Boolean)
        Dim msg As String
        ActiveSheet.Range("A1").Select

        ' Change links to link to current workbook
        Dim alinks As Variant
        Dim i As Integer
        alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
        If Not IsEmpty(alinks) Then
            For i = 1 To UBound(alinks)
                ActiveWorkbook.ChangeLink alinks(i), ActiveWorkbook.FullName, xlExcelLinks
            Next i
        End If

        ' Check whether there are any remaining links to other workbooks
        ' You should never get this error but during development sometimes this occurred
        alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
        If Not IsEmpty(alinks) Then
            MsgBox "** Warning **" & Chr(13) & "There are unresolved links to other spreadsheets!"
            For i = 1 To UBound(alinks)
                msg = msg & alinks(i) & " *** "
            Next i
            MsgBox msg
        End If


        ' Reactive the formula that link the text boxes to worksheet cells
        ' This is required since the textboxes with named rang links did not always update to the current value in the cell
        
        Dim sh, gsh As Shape, txtboxFormula As String
        
        For Each sh In ActiveSheet.Shapes
            
            If sh.Type = msoTextBox Then
                ' the shape is a text box
                sh.Select   ' select the object
                'Note the .formula property seems to work with text boxes only if you select them individually
                txtboxFormula = Selection.Formula
                If txtboxFormula <> "" Then
                    ' update the formula
                    Selection.Formula = txtboxFormula
                    Selection.Font.ColorIndex = 1           ' change colour to black
                    'If apr Then Selection.Font.Size = 10
                    'sh.TextFrame.AutoSize = msoTrue        'ensure the text box expands to the linked value
                End If
            ElseIf sh.Type = msoGroup Then
                ' shape is a group run through each shape in the group
                'If apr Then Selection.Font.Size = 10
                For Each gsh In sh.GroupItems
                    If gsh.Type = msoTextBox Then
                        ' the shape is a text box
                        gsh.Select   ' select the object
                        'Note the .formula property seems to work with text boxes only if you select them individually
                        txtboxFormula = Selection.Formula
                        If txtboxFormula <> "" Then
                            ' update the formula
                            Selection.Formula = txtboxFormula <----------ERRO DÁ AQUI--------------
                            Selection.Font.ColorIndex = 1           ' change colour to black
                            'If apr Then Selection.Font.Size = 10
                            'gsh.TextFrame.AutoSize = msoTrue        'ensure the text box expands to the linked value
                        End If
                    Else
                        'MsgBox "Other type"
                    End If
                Next
            End If
        Next

        Set sh = Nothing
        ActiveSheet.Range("A1").Select
        Exit Sub
    errorHandler:
        MsgBox "Unexpected Error when updating links"
    End Sub

     Obrigado pela ajuda, apesar de achar ser melhor enviar o ficheiro para perceberem melhor.

     Abraços,

     Jorge

    segunda-feira, 27 de maio de 2013 11:29

Respostas

  • Troque a linha que está dando erro por:

    Selection.Formula = "=" & txtboxFormula

    Nota: recebi o arquivo por e-mail. Em minha opinião, o que me enviou é claramente um sistema que foi feito por profissionais da área de programação no Excel. Sugiro que entre em contato com a empresa que desenvolveu o sistema para você e explique os problemas que está tendo.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta Jorge F. Costa segunda-feira, 27 de maio de 2013 21:03
    segunda-feira, 27 de maio de 2013 17:21
    Moderador

Todas as Respostas

  • Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum.

    ---

    É melhor você disponibilizar a pasta de trabalho porque fiz alguns testes e as coisas parecem funcionar normalmente com o Excel 2013.



    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 27 de maio de 2013 13:09
    Moderador
  • Obrigado pela resposta, para a próxima coloco o código no local indicado.

    Onde posso colocar os ficheiros para veres ? posso enviar por email ?

     Jorge

     

    segunda-feira, 27 de maio de 2013 15:12
  • http://www.ambienteoffice.com.br/outros/como_disponibilizar_um_arquivo_para_download/

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 27 de maio de 2013 16:09
    Moderador
  • Pelo skydive não posso, estou no trabalho agora, não tenho permissões.

    Enviei para o email mencionado. Obrigado pela atenção

    Jorge

    segunda-feira, 27 de maio de 2013 16:22
  • Troque a linha que está dando erro por:

    Selection.Formula = "=" & txtboxFormula

    Nota: recebi o arquivo por e-mail. Em minha opinião, o que me enviou é claramente um sistema que foi feito por profissionais da área de programação no Excel. Sugiro que entre em contato com a empresa que desenvolveu o sistema para você e explique os problemas que está tendo.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta Jorge F. Costa segunda-feira, 27 de maio de 2013 21:03
    segunda-feira, 27 de maio de 2013 17:21
    Moderador
  • Dá o mesmo erro.....paciência
    segunda-feira, 27 de maio de 2013 17:34