Luôn mặc định chữ in hoa khi nhập dữ liệu vào bảng tính (1 người xem)

[PhanTuHuong]

Khi sử dụng kiểu gõ Unicode, để nhập chữ in hoa, thông thường phải sử dụng phím Caps Lock. Nhưng tôi có 1 cách chuyển tự động chuyển chữ thường thành chữ hoa bằng cách sử dụng VBA. Đầu tiên ấn Alt+F11, cửa sổ MVB hiện ra, sau đó chọn Sheet nào bạn muốn rồi bấm đúp để hiện cửa sổ code, sau đó copy dòng này vào:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Target, Range("A1:O30")) Is Nothing Then
    Target.Value = UCase(Target.Value)
  End If
End Sub

Range("A1:O30") là vùng tuỳ chọn, hãy thử xem sao!

 

[dongducnhiem]

Mình làm rồi nhưng vẫn bị

Kg biết bạn làm ntn?
Chép code này vào Sheet

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
  If Not Application.Intersect(Target, Range("A1:O30")) Is Nothing Then
    Target.Value = UCase(Target.Value)
  End If
End Sub

 

[stao]

Kg biết bạn làm ntn?
Chép code này vào Sheet

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
  If Not Application.Intersect(Target, Range("A1:O30")) Is Nothing Then
    Target.Value = UCase(Target.Value)
  End If
End Sub

Quái lạ. Làm y chang trên Office 2010 thì lỗi khởi động lại office. Còn đem qua 2003 thì không sao. Chả hiểu nổi.

 

[Quang_Hải]

Quái lạ. Làm y chang trên Office 2010 thì lỗi khởi00EC không sao. Chả hiểu nổi.

Mở phím CAPLOCK lên cho khoẻ khỏi phải nhức đầu

 

[Hong.Van]

Mở phím CAPLOCK lên cho khoẻ khỏi phải nhức đầu

Vì anh kg fải là dân kế toán nên chưa thấy sự cần thiết của code trên, trong kế toán có những cột fải yêu cầu nhập toàn bộ là chữ HOA (Ví dụ: ký hiệu hóa đơn) , nếu cứ bấm Caplock hoài mõi tay & kg tập trung!
Em thấy code trên chạy trên Ex 2010 thì bị lỗi thật. Anh đã là chuyên gia về code thì cho biết tại sao nó bị lỗi như vậy?
Em cảm ơn!

 

[Quang_Hải]

Vì anh kg fải là dân kế toán nên chưa thấy sự cần thiết của code trên, trong kế toán có những cột fải yêu cầu nhập toàn bộ là chữ HOA (Ví cứ bấm Caplock hoài mõi tay & kg tập trung!
Em thấy code trên chạy trên Ex 2010 thì bị lỗi thật. Anh đã là chuyên gia về code thì cho biết tại sao nó bị lỗi như vậy?
Em cảm ơn!

Khi sử dụng sự kiện Sheet_Change thì phải lưu ý câu lệnh Application.EnableEvents = False và Application.EnableEvents = True trước khi thoát sub
Vì khi Target= Ucase(Target) đã tạo ra 1 sự kiện mới
Mình chỉ đoán thế thôi nhưng chưa test đoạn code trên vì mình xài 2007

 

[Hong.Van]

Khi sử dụng sự kiện Sheet_Change thì phải lưu ý câu lệnh Application.EnableEvents = False và Application.EnableEvents = True trước khi thoát sub
Vì khi Target= Ucase(Target) đã tạo ra 1 sự kiện mới
Mình chỉ đoán thế thôi nhưng chưa test đoạn code trên vì mình xài 2007

Em đã text trên 2010, kết quả tốt
Cảm ơn anh vì học thêm 1 chiêu mới
--------
P/s: mà sao anh kg chuyển Ex 2007 lên 2010 nhỉ? nghe đồn Ex 2007 dễ phát sinh lỗi so với 2003 hay 2010?

 

[stao]

Em đã text trên 2010, kết quả tốt
Cảm ơn anh vì học thêm 1 chiêu mới
--------
P/s: mà sao anh kg chuyển Ex 2007 lên 2010 nhỉ? nghe đồn Ex 2007 dễ phát sinh lỗi so với 2003 hay 2010?

Ok mình đã làm được. Tks all!

 

[Hong.Van]

Bạn chỉnh thế nào mà hết lỗi nhỉ

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
  If Not Application.Intersect(Target, Range("A1:O30")) Is Nothing Then
    Target.Value = UCase(Target.Value)
  End If
  Application.EnableEvents = True
End Sub

 

[ndu96081631]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
  If Not Application.Intersect(Target, Range("A1:O30")) Is Nothing Then
    Target.Value = UCase(Target.Value)
  End If
  Application.EnableEvents = True
End Sub

Thế nếu người ta không gõ mà copy nhiều cell rồi paste thì code nó.. tèo à?
Đã nói đến ChangeCase thường người ta sẽ viết luôn code cho 3 trường hợp: UPPER, LOWER và Proper luôn (tôi đã từng viết và post lên diễn đàn rồi)

 

[Hong.Van]

Thế nếu người ta không gõ mà copy nhiều cell rồi paste thì code nó.. tèo à?
Đã nói đến ChangeCase thường người ta sẽ viết luôn code cho 3 trường hợp: UPPER, LOWER và Proper luôn (tôi đã từng viết và post lên diễn đàn rồi)

Nếu được, Thầy cho em đường Link!
Em cảm ơn

 

[ndu96081631]

Nếu được, Thầy cho em đường Link!
Em cảm ơn

Tôi gửi code luôn đây:
1> Hàm ChangeCase cho 1 chuổi:

Function ChangeCaseFromString(ByVal Text As String, ByVal CaseType As Long) As String
  ''CaseType = 1 ---> lower
  ''CaseType = 2 ---> UPPER
  ''CaseType = 3 ---> Proper
  Dim i As Long, tmp As String
  On Error Resume Next
  If Trim(Text) <> "" And Not (IsNumeric(Text)) Then
    Select Case CaseType
      Case 1: ChangeCaseFromString = LCase(Text)
      Case 2: ChangeCaseFromString = UCase(Text)
      Case 3
        tmp = Trim(Text)
        If Len(tmp) = 1 Then
          ChangeCaseFromString = UCase(tmp)
        Else
          tmp = UCase(Left(tmp, 1)) & LCase(Mid(tmp, 2, Len(tmp)))
          For i = 2 To Len(tmp)
            If UCase(Mid(tmp, i, 1)) <> LCase(Mid(tmp, i, 1)) Then
              If UCase(Mid(tmp, i - 1, 1)) = LCase(Mid(tmp, i - 1, 1)) Then
                tmp = Left(tmp, i - 1) & Replace(tmp, Mid(tmp, i, 1), UCase(Mid(tmp, i, 1)), i, 1)
              End If
            End If
          Next
          ChangeCaseFromString = tmp
        End If
    End Select
  Else
    ChangeCaseFromString = Text
  End If
End Function

2> Hàm ChangeCase cho 1 Array hoặc 1 Range:

Function ChangeCase(ByVal sArray, ByVal CaseType As Long)
  Dim tmpArr, TmpStr As String, i As Long, j As Long
  On Error Resume Next
  tmpArr = sArray
  If TypeName(tmpArr) <> "Variant()" Then
    tmpArr = ChangeCaseFromString(tmpArr, CaseType)
  Else
    TmpStr = Join(tmpArr, " ")
    If TmpStr <> "" Then
      For i = LBound(tmpArr) To UBound(tmpArr)
        tmpArr(i) = ChangeCaseFromString(tmpArr(i), CaseType)
      Next
    Else
      For i = LBound(tmpArr, 1) To UBound(tmpArr, 1)
        For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
          tmpArr(i, j) = ChangeCaseFromString(tmpArr(i, j), CaseType)
        Next
      Next
    End If
  End If
  ChangeCase = tmpArr
End Function

3> Thủ tục để kích hoạt ChangeCase trên 1 vùng

Sub ChangeCaseFormRange(ByVal SrcRng As Range, ByVal CaseType As Long)
  Dim sArray, Area As Range, i As Long, j As Long
  On Error Resume Next
  With SrcRng
    If .Count = 1 Then
      .Formula = ChangeCase(.Formula, CaseType)
    Else
      For Each Area In .Areas
        sArray = Area.Formula
        sArray = ChangeCase(sArray, CaseType)
        Area.Formula = sArray
      Next
    End If
  End With
End Sub

4> Áp dụng vào sự kiện Worksheet_Change:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range
  On Error Resume Next
  If Not Intersect(Target, [E2:E5000]) Is Nothing Then
    Set Rng = Intersect(Target, [E2:E5000])
    Application.EnableEvents = False
    ChangeCaseFormRange Rng, 2 
  End If
  Application.EnableEvents = True
End Sub

Bộ công cụ ChangeCase này có thể hoạt động trên Range, Array hoặc 1 chuổi. Nó cho phép ChangeCase ngay cả chuổi nằm trong công thức luôn