I just notice that when the macro runs at least one time and then I attemp to close the file I am getting this error:
Error 1004
Error in method "Intersect" on object "Global"
(sorry I dont know how to insert a image from url)
This is the line with the error:
Case "PROVEEDORES"
If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
End If
The error comes up each time the macro runs, for example, If I run the macro on Sheet1, the error is present in the line of that sheet. If I run the macro on several Sheets, the error comes in the last sheet used when closing the file
Help on this please, here is my entire code:
This workbook module:
Private Sub Workbook_Activate()
ChkSelection ActiveSheet
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ToggleCutCopyAndPaste True
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Deactivate()
ToggleCutCopyAndPaste True
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Open()
ChkSelection ActiveSheet
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ChkSelection Sh
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ChkSelection Sh
End Sub
Sub ChkSelection(ByVal Sh As Object)
Select Case Sh.Name
Case "CLIENTE PN"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(15)) Is Nothing
Case "CLIENTE PJ"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
Case "CONCESIONARIOS"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(10)) Is Nothing
Case "PROVEEDORES"
If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
End If
Case "EMPLEADOS"
If Not Intersect(Selection, Sh.Columns(12)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(12)) Is Nothing
ElseIf Not Intersect(Selection, Sh.Columns(16)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(16)) Is Nothing
End If
Case Else
ToggleCutCopyAndPaste True
End Select
End Sub
Sub ToggleCutCopyAndPaste(v_true As Boolean)
EnableMenuItem Array(19, 21, 22, 755), v_true
For k = 1 To 6
If v_true Then Application.OnKey Choose(k, "^c", "^j", "^v", "^x", "+{DEL}", "^{INSERT}")
If Not v_true Then Application.OnKey Choose(k, "^c", "^j", "^v", "^x", "+{DEL}", "^{INSERT}"), "CutCopyPasteDisabled"
Next
End Sub
Sub EnableMenuItem(ctlId, v_Enabled As Boolean)
On Error Resume Next
For Each cb In Application.CommandBars
If cb.Name <> "Clipboard" Then
For Each it In ctlId
cb.FindControl(, it).Enabled = v_Enabled
Next
End If
Next
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Index = 2 Then ' 2'st sheet in workbook
If Target.Column = 15 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 3 Then ' 3'st sheet in workbook
'End S
If Target.Column = 13 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 4 Then ' 4'st sheet in workbook
If Target.Column = 10 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 5 Then ' 5'st sheet in workbook
If Target.Column = 13 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 5 Then ' 5'st sheet in workbook
If Target.Column = 17 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 6 Then ' 5'st sheet in workbook
If Target.Column = 12 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 6 Then ' 5'st sheet in workbook
If Target.Column = 16 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
End Sub
In a Standard module:
Sub CutCopyPasteDisabled()
MsgBox "Lo sentimos, la fecha no puede ser copiada de otra celda"
End Sub
Maybe the error comes with the Sub Workbook_BeforeClose() ??