Customize Ribbon in Excel|Add Your Own Groups Using Custom UI Editor

Опубликовано: 21 Октябрь 2024
на канале: The World Of Algorithms
1,047
like

💡 Source Code

Sub ShowCalculator()
Application.ActivateMicrosoftApp Index:=0
End Sub

Sub CellClear()
Cells.Clear
MsgBox "Done", vbInformation + vbOKOnly, ""
End Sub

Sub ProtectWbStructure()
ThisWorkbook.Protect Password:="algorithm", Structure:=True, Windows:=False
MsgBox "The structure of the workbook has been locked to prevent unwanted " & _
"changes, such as moving, deleting, or adding sheets", vbInformation + vbOKOnly, ""

Rem This message is the DEFAULT MESSAGE TEXT provided by MS EXCEL
End Sub

Sub SendToDB()
Dim ws As Worksheet, t As String
Set ws = Worksheets("Database")
t = InputBox("Type the word to be added to the database. " & vbNewLine & _
"Minimum number of characters: 5", "")
If Len(t) ▶ 5 Then
MsgBox "The number of characters is less than 5. The operation was stopped", _
vbExclamation + vbOKOnly, ""
Exit Sub
Else:
ws.Cells(Rows.Count, 1).End(XlDirection.xlUp).Offset(1, 0).Value = t
ws.Columns(1).AutoFit
MsgBox "The information you entered has been added to the database", _
vbInformation + vbOKOnly, ""
End If
End Sub

Sub SendSelectionToOutlook()
Dim oApp As New Outlook.Application, oMail As Object, rng As Range, _
subj As String, b As String, i As Integer, k As Integer
With Application
.ScreenUpdating = 0
Set oMail = oApp.CreateItem(olMailItem)
oApp.Session.Logon
subj = InputBox("Mail Subject", "", "")
Set rng = Selection
For i = 1 To rng.Columns.Count
For k = 1 To rng.Rows.Count
If rng.Cells(k, i) ◀▶ "" Then b = b & rng.Cells(k, i).Value & vbNewLine
Next k
Next i
With oMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = subj
.Body = b
.Send
End With
Set oMail = Nothing
Set oApp = Nothing
.ScreenUpdating = -1
End With
MsgBox "The process of sending data has been completed", vbInformation + vbOKOnly, "'"
End Sub

Sub ShowCalculatorGroup(control As IRibbonControl)
Call ShowCalculator
End Sub

Sub ShowCellClearGroup(control As IRibbonControl)
Call CellClear
End Sub

Sub ShowProtectWbStructureGroup(control As IRibbonControl)
Call ProtectWbStructure
End Sub

Sub ShowSendToDBGroup(control As IRibbonControl)
Call SendToDB
End Sub

Sub ShowSendSelectionToOutlookGroup(control As IRibbonControl)
Call SendSelectionToOutlook
End Sub

------------------------------------------------------------------------------------------
Buy a Cofee ☕ for theworldofalgorithms: https://ko-fi.com/theworldofalgorithms

🥰Thank you for the donation. I am deeply grateful for your help!🥰
------------------------------------------------------------------------------------------

#excel
#msexcel
#msexceltutorial
#msexcelcourse
#vba
#vbatutorial
#excelvba
#fulltutorial
#excelvbatutorial
#microsoftexceltutorial
#tutorial
#exceltutorial
#advancedexcel
#advancedexceltraining
#algorithm
#algorithms
#programming
#program
#script
#vbamacro
#vbamacros
#usingmacro
#veryuseful
#useful
#veryusefulmacro
#freeeducation
#freeprogramming
#freelancer
#excelfreelancer
#vbafreelancer
#freelanceservices
#inputbox
#excelinputbox
#excelvbainputbox
#vbainputbox
#form
#userform
#exceluserform
#vbauserform
#excelvbauserform
#vbaform
#label
#ribbon
#ribboncustomization
#customuieditor
#xml
#excelvbasendmail
#mail
#customize
#customizeribbon
#excelcustomizeribbon
#addtab