Chuyển code sang addin dùng phím tắt

[songiang5011]

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

Bài đã được tự động gộp: 6/7/23

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

 

[Nhattanktnn]

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

Bài đã được tự động gộp: 6/7/23

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

Đoạn code này bạn lấy ở đâu vậy nhỉ, code này mình viết mà mình không nhớ đã hỗ trợ bạn nào trên diễn đàn chưa (Mình chỉ tò mò xem mình viết ở bài nào thôi )

 

[Thóc Sama]

Đoạn code này bạn lấy ở đâu vậy nhỉ, code này mình viết mà mình không nhớ đã hỗ trợ bạn nào trên diễn đàn chưa (Mình chỉ tò mò xem mình viết ở bài nào thôi )

Đứa con tinh thần, nhìn cái phát hiện ra luôn bác hả?

 

[Nhattanktnn]

Đứa con tinh thần, nhìn cái phát hiện ra luôn bác hả?

Trong cái addin của mình có khúc này mà hihi

 

[Hoàng Tuấn 868]

Trong cái addin của mình có khúc này mà hihi

Hồi đấy mà thêm đoạn tạo phím tắt theo ý muốn thì không có bài này nữa nhỉ.

 

[Nhattanktnn]

Hồi đấy mà thêm đoạn tạo phím tắt theo ý muốn thì không có bài này nữa nhỉ.

Em viết ribbon ấy, nên không có khúc đó

 

[Hoàng Tuấn 868]

Em viết ribbon ấy, nên không có khúc đó

Vậy là nhìn chưa xa, trông chưa rộng rồi.

 

[Thóc Sama]

Vậy là nhìn chưa xa, trông chưa rộng rồi.

Này gọi là không thương mại hóa được rồi.

 

[songiang5011]

Đoạn code này bạn lấy ở đâu vậy nhỉ, code này mình viết mà mình không nhớ đã hỗ trợ bạn nào trên diễn đàn chưa (Mình chỉ tò mò xem mình viết ở bài nào thôi )

em lấy trên diễn đàn, em thấy hay lên em dùng ạ.

 

[songiang5011]

Mình đặt phím tắt là Alt + z, bạn xem thử.

dạ em cám ơn anh, em làm được rồi ạ

 

[songiang5011]

Trong cái addin của mình có khúc này mà hihi

Em thấy anh có Addin SOLVER, anh cho em xin addin đấy với ạ. Em cám ơn

 

[Nhattanktnn]

Em thấy anh có Addin SOLVER, anh cho em xin addin đấy với ạ. Em cám ơn

Solver mình cài excel là có sẵn rồi nha

 

[Mutants Men]

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

Bài đã được tự động gộp: 6/7/23

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ạn tham khảo tại đây sử dụng Application.Onkey

 

[Forever1Love]

mình hay dùng cái này

Sub abc()
'code
End Sub

Sub abc_Shortcut()
Application.OnKey "+^{R}", "abc"
' + là ctrl
' ^ là shift
' % là alt
End Sub

Private Sub Workbook_Open()
Call module.abc_Shortcut
end sub