Como verificar se um evento já existe?

2024 - VBA & Macros

Post Recente por Basole 7 anos atrás

2 Posts

2 Usuários

0 Reactions

991 Visualizações

RSS

klarc28

(@klarc28)

Posts: 971

Prominent Member

Topic starter

A macro a seguir cria um evento, mas, mesmo se o evento existir, e a macro for executada novamente, cria o evento novamente. Como fazer para o evento ser criado somente se ele não existir? Ou então excluir se ele já existir e criar novamente?

Sub AddCodInSheet() 'adiciona o código CALCULATE no evente Selection Change da planilha ativa

        Dim VBProj As Object
        Dim VBComp As Object
        Dim CodeMod As Object

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents(ActiveSheet.Name)  'Nome da sua Sheet
        Set CodeMod = VBComp.CodeModule
        
        
        Dim strNewCode As String
        
        strNewCode = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & Chr(10) _
                   & "    Calculate" & Chr(10) _
                   & "     'seleção ativada" & Chr(10) _
                   & "End Sub"
        
        CodeMod.AddFromString strNewCode
                
End Sub

Postado : 29/01/2018 1:09 pm

Basole

(@basole)

Posts: 487

Reputable Member

Segue exemplo adaptado:

Public Sub insert_sheet_tracking_code()
    Dim StartLine As Long
    ActiveWorkbook.Worksheets(1).Activate

    With ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.ActiveSheet.CodeName).CodeModule
   
        On Error Resume Next
        If .ProcBodyLine("Worksheet_SelectionChange", vbext_pk_Proc) = 0 Then
            Rem evento nao existe

            On Error GoTo 0
            StartLine = .CreateEventProc("SelectionChange", "worksheet") + 1
            .InsertLines StartLine, _
             "                Calculate" & Chr(10) _
                   & "              'seleção ativada"
                
        Else
            MsgBox "ja existe"
            On Error GoTo 0
        End If
    End With
    
End Sub

fonte: https://www.ozgrid.com/forum/forum/help ... ore-adding

Click em se a resposta foi util!