Executing code when a textbox is selected

[dpaton05]

How to I execute code if a textbox is clicked in so the cursor appears on a locked sheet?

I want to unprotect my worksheet when a textbox has the cursor placed in it to type and protect it when the user has finished typing in it.


If you can't do that, can you protect a sheet but unprotect a textbox, allowing you to press enter to go to a new line while the sheet is protected?

 

[Michael M]

Did you use the standard keypad when you pressed SHIFT + Enter ?......NOT the Num Keypad

 

[dpaton05]

Not at work today but I think I did.

 

[dpaton05]

That is strange, I pressed shift+enter on my pc at home and it worked as you suggested. I will try again when I am next back at work

 

[Michael M]

Dontcha luv technology !!!

 

[dpaton05]

Still doing the same thing Michael, I press shift + enter and it zooms to the very last row on the sheet.

 

[dpaton05]

Not sure if this will help but here is the code in the sheet that has the text box.

Option Explicit
Const ToUnlock As String = "word"


Private Sub cmdAdd_Nlines_Click()
Quoting.Unprotect password:=ToUnlock
    Call Addlines
Quoting.Protect password:=ToUnlock
End Sub

Private Sub cmdCustom_Click()
Quoting.Unprotect password:=ToUnlock
    Call cmdCustomSig
Quoting.Protect password:=ToUnlock
End Sub

Private Sub cmdDelCol_Click()
Quoting.Unprotect password:=ToUnlock
    Call ClearAllButDates
Quoting.Protect password:=ToUnlock
End Sub

Private Sub cmdDeleteQuoteLines_Click()
Quoting.Unprotect password:=ToUnlock
    Call cmdDeleteAllQuoteLines
    
Quoting.Protect password:=ToUnlock
End Sub
Private Sub cmdDeleteRow_Click()
Quoting.Unprotect password:=ToUnlock
    Call DeleteRowBottom
Quoting.Protect password:=ToUnlock
End Sub
Private Sub cmdDelSelect_Click()
Quoting.Unprotect password:=ToUnlock
    Call cmdDelSelected
Quoting.Protect password:=ToUnlock
End Sub
Private Sub cmdGarrettB_Click()
Quoting.Unprotect password:=ToUnlock
    Call cmdNoSig
    Call cmdGarrettSig
Quoting.Protect password:=ToUnlock
End Sub

Private Sub cmdLynS_Click()
Quoting.Unprotect password:=ToUnlock
    Call cmdNoSig
Quoting.Protect password:=ToUnlock
End Sub

Private Sub cmdTraceyS_Click()
Quoting.Unprotect password:=ToUnlock
    Call cmdNoSig
    Call cmdTraceySig
Quoting.Protect password:=ToUnlock
End Sub

Private Sub cmdNoSignature_Click()
Quoting.Unprotect password:=ToUnlock
    Call cmdNoSig
Quoting.Protect password:=ToUnlock
End Sub
Private Sub cmdSendTCT_Click()
Quoting.Unprotect password:=ToUnlock
    Call cmdSendNP
    Quoting.Activate
    Call AddReference
Quoting.Protect password:=ToUnlock
End Sub
Private Sub Textbox4_Click()

    'Call Size(TextBox4)
    With ActiveSheet.Shapes("TextBox4")
        .TextFrame.Characters.Text = ""
        .Select
    End With
End Sub
Sub Rectangle1_Click()
    With ActiveSheet.Shapes("TextBox4")
        .TextFrame.Characters.Text = ""
        .Select
    End With
End Sub

Private Sub TextBox4LostFocus()
    'Call Size(TextBox4)
End Sub
Private Sub TextBox4_Change()
   'Call Size(TextBox4)
End Sub
Private Sub Size(tb As Object)
Quoting.Unprotect password:=ToUnlock
    With tb
        .AutoSize = True
        .Width = 540
        .EnterKeyBehavior = True
        .MultiLine = True
    End With
Quoting.Protect password:=ToUnlock
End Sub
Private Sub cmdSendTCTPrint_Click()
Quoting.Unprotect password:=ToUnlock
    Call cmdSend
    Quoting.Activate
    Call AddReference
Quoting.Protect password:=ToUnlock
End Sub
Sub Backup()
Quoting.Unprotect password:=ToUnlock
    Dim newName As String, wb1 As Workbook, sh1 As Worksheet
    Dim sh2 As Worksheet
    
    Set wb1 = ThisWorkbook
    Set sh1 = wb1.Worksheets("CSS_quote_sheet")
     
    On Error Resume Next
    newName = "Backup"
 
    If newName <> "" Then
        ActiveSheet.Copy After:=Worksheets(Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = newName
    End If
    sh1.Activate
Quoting.Protect password:=ToUnlock
End Sub

Private Sub CommandButton7_Click()
Quoting.Unprotect password:=ToUnlock
    Call save_pdf
Quoting.Protect password:=ToUnlock
End Sub



Private Sub CommandButton4_Click()
Quoting.Unprotect password:=ToUnlock
Dim lowestrow As String
    lowestrow = Sheets("CSS_quote_sheet").TextBoxes("TextBox4").BottomRightCell.Row
    MsgBox lowestrow
Quoting.Protect password:=ToUnlock
End Sub

Private Sub CommandButton5_Click()
Quoting.Unprotect password:=ToUnlock
    With Sheets("CSS_quote_sheet").PageSetup
        .CenterHeader = ""
        .CenterFooter = ""
    End With
Quoting.Protect password:=ToUnlock
End Sub

Private Sub CommandButton6_Click()
Quoting.Unprotect password:=ToUnlock
    With Sheets("CSS_quote_sheet").PageSetup
        .CenterHeader = ThisWorkbook.Worksheets("sheet2").Shapes("WestHead")
        .CenterFooter = ""
    End With
Quoting.Protect password:=ToUnlock
End Sub



Private Sub CommandButton9_Click()
Quoting.Unprotect password:=ToUnlock
    Dim shp As Shape
    ThisWorkbook.Worksheets("CSS_quote_sheet").PageSetup.LeftHeader = "&G"
    Set shp = ThisWorkbook.Worksheets("sheet2").Shapes("ImgWestHeader") 'need to find out the name of the shape you want to copy
    ThisWorkbook.Worksheets("CSS_quote_sheet").PageSetup.LeftHeader = shp
    shp.Copy
    ThisWorkbook.Sheets("CSS_quote_sheet").Paste
    With Selection
        .Top = 0 'plug in desired coordinateion
        .Left = 0
    End With
Quoting.Protect password:=ToUnlock
End Sub



Private Sub TextBox1_Change()
Quoting.Unprotect password:=ToUnlock
    Dim hBox As Double, h As Double, h5 As Double, H6 As Double
    h5 = Me.Rows(5).RowHeight
    H6 = Me.Rows(6).RowHeight
    
    With Me.Shapes("TextBox1")
        hBox = .Height
        .Top = Me.Rows(4).Top + 10
    End With
    h = hBox - h5 - H6
    If h > 0 Then
        Me.Rows("7:8").RowHeight = h / 2
    Else
        Me.Rows("7:8").RowHeight = 0
    End If
Quoting.Protect password:=ToUnlock
End Sub

Private Sub Worksheet_Activate()
Quoting.Unprotect password:=ToUnlock
Dim LastRow As Long
LastRow = Quoting.Range("B10").End(xlUp).Row + 8
    Quoting.Range("A1:P" & LastRow).Locked = True
Quoting.Protect password:=ToUnlock
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Quoting.Unprotect password:=ToUnlock
    If Range("B5").Value = "/" Then
         MsgBox ("Please call maintenance immediately to refill reservoir")
    End If
'Quoting.Protect password:=ToUnlock
End Sub
Private Sub cmdSort_Click()
Quoting.Unprotect password:=ToUnlock
    Call SortColumn
Quoting.Protect password:=ToUnlock
End Sub

Private Sub TextBox4_AfterUpdate()
    Quoting.Protect password:=ToUnlock
End Sub
Private Sub TextBox4_LostFocus()
    Debug.Print "quoting.Protect password:=ToUnlock"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    'Quoting.Unprotect password:=ToUnlock
      Dim ans As String
    
    'code to enter allow organisation to be entered if other is selected
        If Not Intersect(Target, Me.Range("B7")) Is Nothing Then
            If LCase(Me.Range("B7").Value) = "other" Then
                ans = InputBox("Please enter organisation.", , Me.Range("B7").Value)
                If ans <> "" Then
                    Range("B7").Value = ans
                End If
            End If
        End If
    
        If Selection.Count = 1 Then
     
            'If Not Intersect(Target, Range("B7")) Is Nothing Then
           '     Workbooks.Open ThisWorkbook.Path & "\" & "Client_list.xlsm"
           ' End If
        End If
      If Target.Count > 1 Or IsEmpty(Target) Then Exit Sub
      '
      On Error GoTo App_Events
      If Not Intersect(Target, Range("A:A,B:B")) Is Nothing Then
    
        Select Case Target.Column
          Case 1
            If Target.Value < Date Then
              If MsgBox("This input is older than today !....Are you sure that is what you want ???", vbYesNo) = vbNo Then
                Target.Value = ""
              End If
            End If
          Case 2
            If LCase(Target.Value) = LCase("Activities") Then
              Do
                ans = InputBox("Please enter the Activities cost." & _
                  vbCrLf & "************************************" & vbCrLf & _
                  "To change an activity cost, select Activities from the Service list again.")
                If ans <> "" Then
                  Cells(Target.Row, "M") = ans
                  Exit Do
                Else
                  MsgBox ("You must enter a Activities cost.")
                End If
              Loop
            End If
        End Select
      End If
      
    
      
App_Events:
      Application.EnableEvents = True
    'Quoting.Protect password:=ToUnlock

End Sub



Private Sub Worksheet_Deactivate()
Quoting.Unprotect password:=ToUnlock
With Worksheets("CSS_quote_sheet")
    .Shapes("cmdGarrettB").Visible = True
End With
Quoting.Protect password:=ToUnlock
End Sub

 

[Michael M]

Is the computer at work a laptop ?
AND
Is the texbox activated ?
Works fine for me

 

[dpaton05]

No, it is not a laptop, it is a desktop.

The textbox has the cursor in it as I am typing so I guess it is activated but what do you mean by:

Is the texbox activated

 

[dpaton05]

Don't forget the workbook must be protected.

 

[dpaton05]

I think I have just worked out how I will do this. I am going to unlock a range of cells in the area where the textbox is and when the sheet is protected, I will still be able to type in the cells.