songiang5011
Thành viên mới
- Tham gia
- 6/7/21
- Bài viết
- 43
- Được thích
- 10
Em chào anh chị trong diễn đàn, Em có đoạn code nhờ anh chị trong diễn đàn xử lý giúp em xem có cách nào chuyển sang Addin rồi dùng phím tắt để thao tác không ạ (vị dụ dùng phím CTRL q) để chạy code. Em xin anh chị giúp đỡ em. Em cám ơn
Code em đây ạ
Option Explicit
Private Function VisibleCell(ByVal iCell As Range) As Boolean
'Ham tim o hien,iCell là mot cell duy nhat
'VisibleCell=true ==> Hien
'VisibleCell=False ==> An
Dim X As Range, I As Boolean
Set X = iCell
I = False
If X.EntireRow.Hidden = False Then
If X.EntireColumn.Hidden = False Then
I = True
End If
End If
VisibleCell = I
End Function
Private Sub PasteVisible(ByVal Rng As Range)
Dim Clls As Range, xRng As Range
Set xRng = Rng
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Clls In xRng
If VisibleCell(Clls) Then
Clls.Value = Clls.Value
End If
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Main()
Dim M As String, Rng As Range
M = MsgBox("Ban da chon vung du lieu can thuc hien chua ?" & vbNewLine & "Ban khong the UNDO sau khi thuc hien chuc nang nay !" & vbNewLine & "BAN CO MUON TIEP TUC KHONG ?", vbYesNo, "THONG BAO")
Set Rng = Selection
If M = vbYes Then
Call PasteVisible(Rng)
End If
End Sub
Bài đã được tự động gộp:
Code em đây ạ
Option Explicit
Private Function VisibleCell(ByVal iCell As Range) As Boolean
'Ham tim o hien,iCell là mot cell duy nhat
'VisibleCell=true ==> Hien
'VisibleCell=False ==> An
Dim X As Range, I As Boolean
Set X = iCell
I = False
If X.EntireRow.Hidden = False Then
If X.EntireColumn.Hidden = False Then
I = True
End If
End If
VisibleCell = I
End Function
Private Sub PasteVisible(ByVal Rng As Range)
Dim Clls As Range, xRng As Range
Set xRng = Rng
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Clls In xRng
If VisibleCell(Clls) Then
Clls.Value = Clls.Value
End If
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Main()
Dim M As String, Rng As Range
M = MsgBox("Ban da chon vung du lieu can thuc hien chua ?" & vbNewLine & "Ban khong the UNDO sau khi thuc hien chuc nang nay !" & vbNewLine & "BAN CO MUON TIEP TUC KHONG ?", vbYesNo, "THONG BAO")
Set Rng = Selection
If M = vbYes Then
Call PasteVisible(Rng)
End If
End Sub
