Tạo nút lệnh thực hiện lệnh Freeze và Unfreeze (1 người xem)

  • Thread starter Thread starter iloveit
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

iloveit

Thành viên thường trực
Tham gia
2/3/13
Bài viết
212
Được thích
52
Giới tính
Nam
Nghề nghiệp
Tự do
Chào các anh chị trên diễn đàn.

Tôi đã tạo 1 macro cho Freeze mà 1 macro Unfreeze. Sau đó gán 1 macro cho nút Cuộn trang, 1 macro cho nút Bỏ cuộn.

Bây giờ tôi muốn gán vào nút số 1 khi click vào nút này 1 lần thì thực hiện lệnh Freeze, bấm vào lần nữa thì Unfreeze thì làm thế nào ạ?

Nhờ các anh chị giúp tôi vấn đề này. Cám ơn các anh chị.
 

File đính kèm

Chào Bạn, Bạn dùng tạm code này cho nút số 1 nhé!
Mã:
Sub CuonCuon()  
Application.ScreenUpdating = False
  Range("A6").Select
  With Sheet1.Shapes("Rounded Rectangle 3").TextFrame.Characters
      If .Text = "1" Then
         ActiveWindow.FreezePanes = False
        Else
        ActiveWindow.FreezePanes = True
      End If
    .Text = IIf(.Text = "1 ", "1", "1 ")
  End With
  Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Chào các anh chị trên diễn đàn.

Tôi đã tạo 1 macro cho Freeze mà 1 macro Unfreeze. Sau đó gán 1 macro cho nút Cuộn trang, 1 macro cho nút Bỏ cuộn.

Bây giờ tôi muốn gán vào nút số 1 khi click vào nút này 1 lần thì thực hiện lệnh Freeze, bấm vào lần nữa thì Unfreeze thì làm thế nào ạ?

Nhờ các anh chị giúp tôi vấn đề này. Cám ơn các anh chị.

Mình làm theo ý tưởng sau:
PHP:
Sub FreePanel()
Dim blA As Boolean
    Range("A6").Select
    blA = ActiveWindow.FreezePanes
    If blA = True Then
        ActiveWindow.FreezePanes = False
    Else
        ActiveWindow.FreezePanes = True
    End If
    
End Sub
 
Upvote 0
Code KUMI chạy ok rồi nhưng khi mình đổi số 1 thành CUỘN TRANG thì click vào nút nó vẫn hiện số 1.
 
Upvote 0
Code KUMI chạy ok rồi nhưng khi mình đổi số 1 thành CUỘN TRANG thì click vào nút nó vẫn hiện số 1.
Hì,, bạn dùng code bài #3 nhé hoặc là bạn có thể sửa lại tên tùy thích trong các dầu "" ở code bài #2.
chú ý là tên minhg đặt có dấu cách và không có dấu cách nhé "1" &"1 "
 
Upvote 0
Nếu 1 là đang cuốn và 0 là đang không cuốn thì sửa lại chỗ đỏ KUMI à. Nếu dùng "1" và "1 " thì làm sao mà phân biệt được.

Mã:
Sub CuonCuon()
    Application.ScreenUpdating = False
    Range("A6").Select
    With Sheet1.Shapes("Rounded Rectangle 3").TextFrame.Characters
        If .Text = "1" Then
            ActiveWindow.FreezePanes = False
        Else
            ActiveWindow.FreezePanes = True
        End If
            .Text = IIf(.Text = [COLOR=#ff0000]"0"[/COLOR], "1", [COLOR=#ff0000]"0"[/COLOR])
    End With
    Application.ScreenUpdating = True
End Sub

hoặc
Mã:
Sub CuonCuon()
    Application.ScreenUpdating = False
    Range("A6").Select
    With Sheet1.Shapes("Rounded Rectangle 3").TextFrame.Characters
        If .Text = "Cuon" Then
            ActiveWindow.FreezePanes = False
        Else
            ActiveWindow.FreezePanes = True
        End If
            .Text = IIf(.Text = "Khong cuon", "Cuon", "Khong cuon")
    End With
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu 1 là đang cuốn và 0 là đang không cuốn thì sửa lại chỗ đỏ KUMI à. Nếu dùng "1" và "1 " thì làm sao mà phân biệt được.

Mã:
Sub CuonCuon()
    Application.ScreenUpdating = False
    Range("A6").Select
    With Sheet1.Shapes("Rounded Rectangle 3").TextFrame.Characters
        If .Text = "1" Then
            ActiveWindow.FreezePanes = False
        Else
            ActiveWindow.FreezePanes = True
        End If
            .Text = IIf(.Text = [COLOR=#ff0000]"0"[/COLOR], "1", [COLOR=#ff0000]"0"[/COLOR])
    End With
    Application.ScreenUpdating = True
End Sub

hoặc
Mã:
Sub CuonCuon()
    Application.ScreenUpdating = False
    Range("A6").Select
    With Sheet1.Shapes("Rounded Rectangle 3").TextFrame.Characters
        If .Text = "Cuon" Then
            ActiveWindow.FreezePanes = False
        Else
            ActiveWindow.FreezePanes = True
        End If
            .Text = IIf(.Text = "Khong cuon", "Cuon", "Khong cuon")
    End With
    Application.ScreenUpdating = True
End Sub

Hi,chú ạ,cháu hiểu mà.
Cháu rất cảm ơn chú Chính đã hỗ trợ, sở dĩ cháu dùng "1" & "1 " là vì có thể tác giả thích số 1 như trong file kèm đã gửi chú ạ!
(chú vẫn khỏe chứ ạ). (^_^)!
 
Lần chỉnh sửa cuối:
Upvote 0
Vẽ 1 cái CommandButton và cho code này vào
PHP:
Private Sub CommandButton1_Click()
[A6].Select
With ActiveSheet.CommandButton1
    .Caption = IIf(.Caption = "FREEZE", "UNFREEZE", "FREEZE")
    ActiveWindow.FreezePanes = .Caption = "UNFREEZE"
End With
End Sub
 
Upvote 0
Chào các anh chị trên diễn đàn.

Tôi đã tạo 1 macro cho Freeze mà 1 macro Unfreeze. Sau đó gán 1 macro cho nút Cuộn trang, 1 macro cho nút Bỏ cuộn.

Bây giờ tôi muốn gán vào nút số 1 khi click vào nút này 1 lần thì thực hiện lệnh Freeze, bấm vào lần nữa thì Unfreeze thì làm thế nào ạ?

Nhờ các anh chị giúp tôi vấn đề này. Cám ơn các anh chị.

Gợi ý bạn cách sửa đơn giản nhất:
- Đầu tiên hãy xóa nút bên trái và bên phải, chừa lại nút ở giữa
- Xong, bấm Alt + F11, vào cửa sổ code VBA, sửa Sub CUONTRANG thành:
Mã:
Sub CUONTRANG()
  Dim bChk As Boolean
  Dim str1 As String, str2 As String
  str1 = "CU" & ChrW(7896) & "N TRANG"
  str2 = "B" & ChrW(7886) & " CU" & ChrW(7896) & "N"
  With ActiveSheet.Shapes(Application.Caller)
    .Parent.Range("A6").Activate
    bChk = (.TextFrame.Characters.Text = str1)
    .TextFrame.Characters.Text = IIf(bChk, str2, str1)
    ActiveWindow.FreezePanes = bChk
  End With
End Sub
- Đóng cửa sổ VBA lại và bấm thử nút xem sao
Ẹc... Ẹc...
 
Upvote 0
Gợi ý bạn cách sửa đơn giản nhất:
- Đầu tiên hãy xóa nút bên trái và bên phải, chừa lại nút ở giữa
- Xong, bấm Alt + F11, vào cửa sổ code VBA, sửa Sub CUONTRANG thành:
Mã:
Sub CUONTRANG()
  Dim bChk As Boolean
  Dim str1 As String, str2 As String
  str1 = "CU" & ChrW(7896) & "N TRANG"
  str2 = "B" & ChrW(7886) & " CU" & ChrW(7896) & "N"
  With ActiveSheet.Shapes(Application.Caller)
    .Parent.Range("A6").Activate
    bChk = (.TextFrame.Characters.Text = str1)
    .TextFrame.Characters.Text = IIf(bChk, str2, str1)
    ActiveWindow.FreezePanes = bChk
  End With
End Sub
- Đóng cửa sổ VBA lại và bấm thử nút xem sao
Ẹc... Ẹc...

Hí,,,Ẹc... Ẹc... kính mến (^_-)!
Em biết thế nào Thầy cũng sẽ tham gia mà ... /-*+/
(Đầu năm em xin kính chúc Thầy Sức Khỏe,Hạnh Phúc & Thành Công ... nhé Thầy!)
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom