├── CodingIsFun.xlsm
├── README.md
├── ai.png
├── mChatGPT.bas
└── mIfError.bas
/CodingIsFun.xlsm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/Sven-Bo/excel-add-in-tutorial-template/b4b350fa0504273f18c54e0bab4da0382d1a0a55/CodingIsFun.xlsm
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # How to Create a Custom Excel Add-in (Step-by-Step Guide)
2 | Are you tired of performing repetitive tasks in Microsoft Excel? Do you want to add new functionality to Excel and make it even more powerful? Then this tutorial is for you! In this step-by-step guide, you'll learn how to create a custom add-in for Excel using built-in tools. Whether you're a beginner or an experienced Excel user, this tutorial is easy to follow and packed with helpful tips and tricks.
3 |
4 | ## What You'll Learn
5 |
6 | - How to create a new add-in in Excel
7 | - How to add custom macros to your add-in
8 | - How to customize the ribbon and toolbar for easy access to your add-in
9 | - How to package and distribute your add-in to others
10 |
11 | By the end of this tutorial, you'll have a custom Excel add-in that can help boost your productivity and make your work in Excel more efficient.
12 |
13 |
14 | ## Video Tutorial
15 | [](https://youtu.be/avdVI14AxzM)
16 |
17 | ## Reference
18 | The following website will be used as a reference in this tutorial:
19 | https://bettersolutions.com/vba/ribbon/custom-ui-editor.htm
20 |
21 | ## List of imageMSO values and associated pictures
22 | https://bert-toolkit.com/imagemso-list.html
23 |
24 | ## XML Code for the UI
25 | ```xml
26 |
27 |
28 |
29 |
30 |
31 |
35 |
36 |
37 |
40 |
43 |
44 |
45 |
46 |
47 |
48 | ```
49 |
50 |
51 |
52 |
53 | ## 🤓 Check Out My Excel Add-ins
54 | I've developed some handy Excel add-ins that you might find useful:
55 |
56 | - 📊 **[Dashboard Add-in](https://pythonandvba.com/grafly)**: Easily create interactive and visually appealing dashboards.
57 | - 🎨 **[Cartoon Charts Add-In](https://pythonandvba.com/cuteplots)**: Create engaging and fun cartoon-style charts.
58 | - 🤪 **[Emoji Add-in](https://pythonandvba.com/emojify)**: Add a touch of fun to your spreadsheets with emojis.
59 | - 🛠️ **[MyToolBelt Add-in](https://pythonandvba.com/mytoolbelt)**: A versatile toolbelt for Excel, featuring:
60 | - Creation of Pandas DataFrames and Jupyter Notebooks from Excel ranges
61 | - ChatGPT integration for advanced data analysis
62 | - And much more!
63 |
64 |
65 |
66 | ## 🤝 Connect with Me
67 | - 📺 **YouTube:** [CodingIsFun](https://youtube.com/c/CodingIsFun)
68 | - 🌐 **Website:** [PythonAndVBA](https://pythonandvba.com)
69 | - 💬 **Discord:** [Join our Community](https://pythonandvba.com/discord)
70 | - 💼 **LinkedIn:** [Connect with me](https://www.linkedin.com/in/sven-bosau/)
71 | - 📸 **Instagram:** [Follow me](https://www.instagram.com/codingisfun_official/)
72 |
73 | ## Support My Work
74 | Love my content and want to show appreciation? Why not [buy me a coffee](https://pythonandvba.com/coffee-donation) to fuel my creative engine? Your support means the world to me! 😊
75 |
76 | [](https://pythonandvba.com/coffee-donation)
77 |
78 | ## Feedback
79 | Got some thoughts or suggestions? Don't hesitate to reach out to me at contact@pythonandvba.com. I'd love to hear from you! 💡
80 | 
81 |
--------------------------------------------------------------------------------
/ai.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/Sven-Bo/excel-add-in-tutorial-template/b4b350fa0504273f18c54e0bab4da0382d1a0a55/ai.png
--------------------------------------------------------------------------------
/mChatGPT.bas:
--------------------------------------------------------------------------------
1 | Option Explicit
2 |
3 | '#################################################################################
4 | '## Title: ChatGPT Completions using OpenAI API
5 | '## Author: Sven from CodingIsFun
6 | '## Website: https://pythonandvba.com
7 | '## YouTube: https://youtube.com/@codingisfun
8 | '##
9 | '## Description: This VBA script uses the OpenAI API endpoint "completions" to generate
10 | '## a text completion based on the selected cell and displays the result in a
11 | '## worksheet called OUTPUT_WORKSHEET. If the worksheet does not exist, it will be
12 | '## created. The API key is required to use the API, and it should be added as a
13 | '## constant at the top of the script.
14 | '## To get an API key, sign up for an OpenAI API key at https://openai.com/api/
15 | '#################################################################################
16 |
17 | '=====================================================
18 | ' GET YOUR API KEY: https://openai.com/api/
19 | Const API_KEY As String = ""
20 | '=====================================================
21 |
22 | ' Constants for API endpoint and request properties
23 | Const API_ENDPOINT As String = "https://api.openai.com/v1/completions"
24 | Const MODEL As String = "text-davinci-003"
25 | Const MAX_TOKENS As String = "1024"
26 | Const TEMPERATURE As String = "0.5"
27 |
28 | 'Output worksheet name
29 | Const OUTPUT_WORKSHEET As String = "Result"
30 |
31 |
32 | Sub OpenAI_Completion()
33 |
34 | #If Mac Then
35 | 10 MsgBox "This macro only works on Windows. It is not compatible with macOS.", _
36 | vbOKOnly, "Windows Compatibility Only"
37 | 20 Exit Sub
38 | #End If
39 |
40 | 30 On Error GoTo ErrorHandler
41 | 40 Application.screenupdating = False
42 |
43 | ' Check if API key is available
44 | 50 If API_KEY = "" Then
45 | 60 MsgBox "Please input a valid API key. You can get one from https://openai.com/api/", vbCritical, "No API Key Found"
46 | 70 Application.screenupdating = True
47 | 80 Exit Sub
48 | 90 End If
49 |
50 | ' Get the prompt
51 | Dim prompt As String
52 | Dim cell As Range
53 | Dim selectedRange As Range
54 | 100 Set selectedRange = Selection
55 |
56 | 110 For Each cell In selectedRange
57 | 120 prompt = prompt & cell.Value & " "
58 | 130 Next cell
59 |
60 | ' Check if there is anything in the selected cell
61 | 140 If Trim(prompt) <> "" Then
62 | ' Clean prompt to avoid parsing error in JSON payload
63 | 150 prompt = CleanJSONString(prompt)
64 | 160 Else
65 | 170 MsgBox "Please enter some text in the selected cell before executing the macro", vbCritical, "Empty Input"
66 | 180 Application.screenupdating = True
67 | 190 Exit Sub
68 | 200 End If
69 |
70 | ' Create worksheet if it does not exist
71 | 210 If Not WorksheetExists(OUTPUT_WORKSHEET) Then
72 | 220 Worksheets.Add(After:=Sheets(Sheets.Count)).name = OUTPUT_WORKSHEET
73 | 230 End If
74 |
75 | ' Clear existing data in worksheet
76 | 240 Worksheets(OUTPUT_WORKSHEET).UsedRange.ClearContents
77 |
78 | ' Show status in status bar
79 | 250 Application.StatusBar = "Processing OpenAI request..."
80 |
81 | ' Create XMLHTTP object
82 | Dim httpRequest As Object
83 | 260 Set httpRequest = CreateObject("MSXML2.XMLHTTP")
84 |
85 | ' Define request body
86 | Dim requestBody As String
87 | 270 requestBody = "{" & _
88 | """model"": """ & MODEL & """," & _
89 | """prompt"": """ & prompt & """," & _
90 | """max_tokens"": " & MAX_TOKENS & "," & _
91 | """temperature"": " & TEMPERATURE & _
92 | "}"
93 |
94 | ' Open and send the HTTP request
95 | 280 With httpRequest
96 | 290 .Open "POST", API_ENDPOINT, False
97 | 300 .SetRequestHeader "Content-Type", "application/json"
98 | 310 .SetRequestHeader "Authorization", "Bearer " & API_KEY
99 | 320 .send (requestBody)
100 | 330 End With
101 |
102 | 'Check if the request is successful
103 | 340 If httpRequest.Status = 200 Then
104 | 'Parse the JSON response
105 | Dim response As String
106 | 350 response = httpRequest.responseText
107 |
108 | 'Get the completion and clean it up
109 | Dim completion As String
110 | 360 completion = ParseResponse(response)
111 |
112 | 'Split the completion into lines
113 | Dim lines As Variant
114 | 370 lines = Split(completion, "\n")
115 |
116 | 'Write the lines to the worksheet
117 | Dim i As Long
118 | 380 For i = LBound(lines) To UBound(lines)
119 | 390 Worksheets(OUTPUT_WORKSHEET).Cells(i + 1, 1).Value = ReplaceBackslash(lines(i))
120 | 400 Next i
121 |
122 | 'Auto fit the column width
123 | 410 Worksheets(OUTPUT_WORKSHEET).Columns.AutoFit
124 |
125 | ' Show completion message
126 | 420 MsgBox "OpenAI completion request processed successfully. Results can be found in the 'Result' worksheet.", vbInformation, "OpenAI Request Completed"
127 |
128 | 'Activate & color result worksheet
129 | 430 With Worksheets(OUTPUT_WORKSHEET)
130 | 440 .Activate
131 | 450 .Range("A1").Select
132 | 460 .Tab.Color = RGB(169, 208, 142)
133 | 470 End With
134 |
135 | 480 Else
136 | 490 MsgBox "Request failed with status " & httpRequest.Status & vbCrLf & vbCrLf & "ERROR MESSAGE:" & vbCrLf & httpRequest.responseText, vbCritical, "OpenAI Request Failed"
137 | 500 End If
138 |
139 | 510 Application.StatusBar = False
140 | 520 Application.screenupdating = True
141 |
142 | 530 Exit Sub
143 |
144 | ErrorHandler:
145 | 540 MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & "Line: " & Erl, vbCritical, "Error"
146 | 550 Application.StatusBar = False
147 | 560 Application.screenupdating = True
148 |
149 | End Sub
150 | ' Helper function to check if worksheet exists
151 | Function WorksheetExists(worksheetName As String) As Boolean
152 | 570 On Error Resume Next
153 | 580 WorksheetExists = (Not (Sheets(worksheetName) Is Nothing))
154 | 590 On Error GoTo 0
155 | End Function
156 | ' Helper function to parse the reponse text
157 | Function ParseResponse(ByVal response As String) As String
158 | 600 On Error Resume Next
159 | Dim startIndex As Long
160 | 610 startIndex = InStr(response, """text"":""") + 8
161 | Dim endIndex As Long
162 | 620 endIndex = InStr(response, """index"":") - 2
163 | 630 ParseResponse = Mid(response, startIndex, endIndex - startIndex)
164 | 640 On Error GoTo 0
165 | End Function
166 | ' Helper function to clean text
167 | Function CleanJSONString(inputStr As String) As String
168 | 650 On Error Resume Next
169 | ' Remove line breaks
170 | 660 CleanJSONString = Replace(inputStr, vbCrLf, "")
171 | 670 CleanJSONString = Replace(CleanJSONString, vbCr, "")
172 | 680 CleanJSONString = Replace(CleanJSONString, vbLf, "")
173 |
174 | ' Replace all double quotes with single quotes
175 | 690 CleanJSONString = Replace(CleanJSONString, """", "'")
176 | 700 On Error GoTo 0
177 | End Function
178 | ' Replaces the backslash character only if it is immediately followed by a double quote.
179 | Function ReplaceBackslash(text As Variant) As String
180 | 710 On Error Resume Next
181 | Dim i As Integer
182 | Dim newText As String
183 | 720 newText = ""
184 | 730 For i = 1 To Len(text)
185 | 740 If Mid(text, i, 2) = "\" & Chr(34) Then
186 | 750 newText = newText & Chr(34)
187 | 760 i = i + 1
188 | 770 Else
189 | 780 newText = newText & Mid(text, i, 1)
190 | 790 End If
191 | 800 Next i
192 | 810 ReplaceBackslash = newText
193 | 820 On Error GoTo 0
194 | End Function
195 |
--------------------------------------------------------------------------------
/mIfError.bas:
--------------------------------------------------------------------------------
1 | '*******************************************************************************
2 | '*
3 | '* Author: Sven from CodingIsFun
4 | '* Website: https://pythonandvba.com
5 | '* YouTube: https://youtube.com/@codingisfun
6 | '*
7 | '* This module contains two macros:
8 | '* - IfErrorBlank: Adds an IFERROR function to selected cells and returns a blank cell if an error occurs
9 | '* - IfErrorZero: Adds an IFERROR function to selected cells and returns zero if an error occurs
10 | '*
11 | '*******************************************************************************
12 |
13 | Option Explicit
14 |
15 | Public Sub IfErrorBlank(control As IRibbonControl)
16 | 'Add an IFERROR function to all selected cells with a formula and return a blank cell if an error occurs
17 |
18 | Dim cell As Range
19 |
20 | On Error Resume Next
21 | For Each cell In Selection.Cells
22 | If cell.HasFormula And Not cell.HasArray Then
23 | 'Add the IFERROR function to the formula
24 | cell.formula = AddIfError(cell.formula, """""")
25 | End If
26 | Next cell
27 | On Error GoTo 0
28 | End Sub
29 |
30 | Public Sub IfErrorZero(control As IRibbonControl)
31 | 'Add an IFERROR function to all selected cells with a formula and return zero if an error occurs
32 |
33 | Dim cell As Range
34 |
35 | On Error Resume Next
36 | For Each cell In Selection.Cells
37 | If cell.HasFormula And Not cell.HasArray Then
38 | 'Add the IFERROR function to the formula
39 | cell.formula = AddIfError(cell.formula, 0)
40 | End If
41 | Next cell
42 | On Error GoTo 0
43 | End Sub
44 |
45 | Private Function AddIfError(ByVal formula As String, ByVal errorValue As Variant) As String
46 | 'Adds an IFERROR function to the formula and returns the specified error value if an error occurs
47 |
48 | Dim formulaSeparator As String
49 |
50 | 'Determine the formula separator for the current language settings
51 | formulaSeparator = Application.International(xlListSeparator)
52 |
53 | 'Add the IFERROR function to the formula
54 | AddIfError = "=IFERROR(" & Right(formula, Len(formula) - Len(formulaSeparator)) & formulaSeparator & errorValue & ")"
55 | End Function
56 |
57 |
58 |
--------------------------------------------------------------------------------