💡 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