how to disable Public function macro's

M

Mel

I want to disable some of these private functions below. It prevents
me from running a macro to extract one tab and attach to an email.
The macro works great except now with these new departmental functions
it will not allow to run. I need to temprarily disable these macros
below then re-enable after my macro runs.
thx

Mel


Under 'DDE'

Public Function DDEOpen(OpenFileName$)

Dim oAdd As Object

On Error GoTo DDEOPEN_ERR
Set oAdd =
Application.COMAddIns.Item("DMintegration_NET.Connect").Object
oAdd.DDEOpen OpenFileName

DDEOPEN_END:
Exit Function

DDEOPEN_ERR:
MsgBox "Unable to open the document. A COM conversation could not
be established.", _
vbCritical + vbOKOnly, "Open Text eDOCS DM"
Err.Clear
Resume DDEOPEN_END
End Function
Public Function DDEPrint(OpenFileName$, AppMode As Integer)

Dim oAdd As Object
On Error GoTo DDEOPEN_ERR

Set oAdd =
Application.COMAddIns.Item("DMintegration_NET.Connect").Object
oAdd.DDEPrint OpenFileName, AppMode

DDEOPEN_END:
Set oAdd = Nothing
Exit Function

DDEOPEN_ERR:
MsgBox "Unable to open the document. A COM conversation could not
be established.", _
vbCritical + vbOKOnly, "Open Text eDOCS DM"
Err.Clear
Resume DDEOPEN_END
End Function

Public Function AddWorkSpaceName(workSpaceDoc As Excel.Workbook,
xlSheet As Excel.Worksheet)

On Error Resume Next
With workSpaceDoc
.Names.Add Name:="HUMMWorkSpace",
RefersToR1C1:="=WorkspaceInfo!R1C1:R30C2"
End With
End Function
********************************************************
along with
********************************************************

ModKeyCodes

Private Const XLBar As String = "Worksheet Menu Bar"
Public Sub DMSetControls()

Application.OnKey "%{F4}", "DMExit"
Application.OnKey "^{w}", "DMClose"
Application.OnKey "^{F4}", "DMClose"
' Application.OnKey "^{n}", "DMNew"
Application.OnKey "^{o}", "DMOpen"
Application.OnKey "^{s}", "DMSave"
Application.OnKey "{F12}", "DMSaveAs"
Application.OnKey "+{F12}", "DMSave"
Application.OnKey "^{F12}", "DMOpen"

' Application.OnKey "^{p}", "HUMMFilePrint"
' Application.OnKey "^+{F12}", "HUMMFilePrint"
End Sub
Public Sub DMResetControls()

Application.OnKey "%{F4}", ""
Application.OnKey "^{w}", ""
Application.OnKey "^{F4}", ""
Application.OnKey "^{n}", ""
Application.OnKey "^{o}", ""
Application.OnKey "^{s}", ""
Application.OnKey "{F12}", ""
Application.OnKey "+{F12}", ""
Application.OnKey "^{F12}", ""

End Sub
Sub DMExit()

Dim tmpCtrl As CommandBarControl

Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=752,
recursive:=True)
tmpCtrl.Execute
Set tmpCtrl = Nothing
End Sub
Sub DMClose()

Dim tmpCtrl As CommandBarControl

Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=106,
recursive:=True)
tmpCtrl.Execute
Set tmpCtrl = Nothing
End Sub
Sub DMNew()

Dim tmpCtrl As CommandBarControl

Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=18,
recursive:=True)
tmpCtrl.Execute
Set tmpCtrl = Nothing
End Sub
Sub DMOpen()

Dim tmpCtrl As CommandBarControl

Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=23,
recursive:=True)
tmpCtrl.Execute
Set tmpCtrl = Nothing
End Sub
Sub DMSave()

Dim tmpCtrl As CommandBarControl

Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=3,
recursive:=True)
tmpCtrl.Execute
Set tmpCtrl = Nothing
End Sub
Sub DMSaveAs()

Dim tmpCtrl As CommandBarControl

Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=748,
recursive:=True)
tmpCtrl.Execute
Set tmpCtrl = Nothing
End Sub
 
J

James Ravenswood

I want to disable some of these private functions below.   It prevents
me from running a macro to extract one tab and attach to an email.
The macro works great except now with these new departmental functions
it will not allow to run.   I need to temprarily disable these macros
below then re-enable after my macro runs.
thx

Mel

Under 'DDE'

Public Function DDEOpen(OpenFileName$)

Dim oAdd As Object

    On Error GoTo DDEOPEN_ERR
    Set oAdd =
Application.COMAddIns.Item("DMintegration_NET.Connect").Object
    oAdd.DDEOpen OpenFileName

DDEOPEN_END:
     Exit Function

DDEOPEN_ERR:
     MsgBox "Unable to open the document. A COM conversation could not
be established.", _
     vbCritical + vbOKOnly, "Open Text eDOCS DM"
     Err.Clear
     Resume DDEOPEN_END
End Function
Public Function DDEPrint(OpenFileName$, AppMode As Integer)

Dim oAdd As Object
On Error GoTo DDEOPEN_ERR

    Set oAdd =
Application.COMAddIns.Item("DMintegration_NET.Connect").Object
    oAdd.DDEPrint OpenFileName, AppMode

DDEOPEN_END:
    Set oAdd = Nothing
    Exit Function

DDEOPEN_ERR:
    MsgBox "Unable to open the document. A COM conversation could not
be established.", _
    vbCritical + vbOKOnly, "Open Text eDOCS DM"
    Err.Clear
    Resume DDEOPEN_END
End Function

Public Function AddWorkSpaceName(workSpaceDoc As Excel.Workbook,
xlSheet As Excel.Worksheet)

    On Error Resume Next
    With workSpaceDoc
        .Names.Add Name:="HUMMWorkSpace",
RefersToR1C1:="=WorkspaceInfo!R1C1:R30C2"
    End With
End Function
********************************************************
along with
********************************************************

ModKeyCodes

Private Const XLBar As String = "Worksheet Menu Bar"
Public Sub DMSetControls()

    Application.OnKey "%{F4}", "DMExit"
    Application.OnKey "^{w}", "DMClose"
    Application.OnKey "^{F4}", "DMClose"
'    Application.OnKey "^{n}", "DMNew"
    Application.OnKey "^{o}", "DMOpen"
    Application.OnKey "^{s}", "DMSave"
    Application.OnKey "{F12}", "DMSaveAs"
    Application.OnKey "+{F12}", "DMSave"
    Application.OnKey "^{F12}", "DMOpen"

'    Application.OnKey "^{p}", "HUMMFilePrint"
'    Application.OnKey "^+{F12}", "HUMMFilePrint"
End Sub
Public Sub DMResetControls()

    Application.OnKey "%{F4}", ""
    Application.OnKey "^{w}", ""
    Application.OnKey "^{F4}", ""
    Application.OnKey "^{n}", ""
    Application.OnKey "^{o}", ""
    Application.OnKey "^{s}", ""
    Application.OnKey "{F12}", ""
    Application.OnKey "+{F12}", ""
    Application.OnKey "^{F12}", ""

End Sub
Sub DMExit()

    Dim tmpCtrl As CommandBarControl

    Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=752,
recursive:=True)
    tmpCtrl.Execute
    Set tmpCtrl = Nothing
End Sub
Sub DMClose()

    Dim tmpCtrl As CommandBarControl

    Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=106,
recursive:=True)
    tmpCtrl.Execute
    Set tmpCtrl = Nothing
End Sub
Sub DMNew()

    Dim tmpCtrl As CommandBarControl

    Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=18,
recursive:=True)
    tmpCtrl.Execute
    Set tmpCtrl = Nothing
End Sub
Sub DMOpen()

    Dim tmpCtrl As CommandBarControl

    Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=23,
recursive:=True)
    tmpCtrl.Execute
    Set tmpCtrl = Nothing
End Sub
Sub DMSave()

    Dim tmpCtrl As CommandBarControl

    Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=3,
recursive:=True)
    tmpCtrl.Execute
    Set tmpCtrl = Nothing
End Sub
Sub DMSaveAs()

    Dim tmpCtrl As CommandBarControl

    Set tmpCtrl = Application.CommandBars(XLBar).FindControl(ID:=748,
recursive:=True)
    tmpCtrl.Execute
    Set tmpCtrl = Nothing
End Sub
Click to expand...

Just build a disabling capability into the logic:

Public AmIDisabled As Boolean

Sub MAIN()
AmIDisabled = True
'
'Do some stuff
'
AmIDisabled = False
End Sub

Function TypicalFunction()
If AmIDisabled Then
TypicalFunction = SomeDefaultValue
Exit Sub
End If
'
'conplete function
'
End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
Autorun macro does not autorun... 5
VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key 0
Remove Identical words 0
Can't manually open file after coding. 0
Enable copying function 5
VBA for Dependents shortcut menu 0

Top