Option Explicit
' ==============================
' Mechanical Engg Project Proposal Deck Builder
' Creates a clean, ready-to-fill PPT with all sections you need
' Tested in PowerPoint for Microsoft 365
' ==============================
Public Sub CreateMEProposal()
Dim pres As Presentation
Dim sld As Slide
Dim projTitle As String, teamNames As String, courseInfo As String, instructor
As String
Dim logoPath As String
' --- Collect basic info (feel free to hardcode instead of InputBox) ---
projTitle = Trim(InputBox("Project Title:", "ME Proposal Builder", "High-
Efficiency Heat Exchanger Redesign"))
If projTitle = "" Then projTitle = "Mechanical Engineering Project Proposal"
teamNames = Trim(InputBox("Your Name(s):", "ME Proposal Builder", "Team Alpha:
A. Khan, M. Ali, S. Raza"))
courseInfo = Trim(InputBox("Course/Dept:", "ME Proposal Builder", "ME-402
Capstone • Dept. of Mechanical Engineering"))
instructor = Trim(InputBox("Instructor/Supervisor:", "ME Proposal Builder",
"Dr. Sara Naqvi"))
logoPath = Trim(InputBox("Optional: Path to logo image (leave blank to skip):",
"ME Proposal Builder", ""))
' --- Create new presentation ---
Set pres = Presentations.Add(msoTrue)
pres.ApplyTheme Environ$("ProgramFiles") & "\Microsoft Office\Document Themes
16\Ion.thmx" ' fallback theme; ignore if missing
' --- Global styling tweaks ---
With pres
.SlideMaster.HeadersFooters.Footer.Visible = msoTrue
.SlideMaster.HeadersFooters.Footer.Text = projTitle
.SlideMaster.HeadersFooters.SlideNumber.Visible = msoTrue
.SlideMaster.HeadersFooters.DateAndTime.Visible = msoTrue
End With
' ---------- SLIDES ----------
' 1) Title Slide
Set sld = pres.Slides.Add(1, ppLayoutTitle)
sld.Design = pres.Designs(1)
sld.Shapes.Title.TextFrame.TextRange.Text = projTitle
sld.Shapes.Title.TextFrame.TextRange.Font.Size = 44
sld.Shapes.Placeholders(2).TextFrame.TextRange.Text = teamNames & vbCrLf &
courseInfo & vbCrLf & instructor
If logoPath <> "" Then
On Error Resume Next
sld.Shapes.AddPicture FileName:=logoPath, LinkToFile:=msoFalse,
SaveWithDocument:=msoTrue, _
Left:=sld.Master.Width - 180, Top:=20, Width:=140,
Height:=msoScaleFromTopLeft
On Error GoTo 0
End If
' 2) Introduction & Motivation
AddBullets pres, "Introduction & Motivation", _
Array( _
"Context: brief background of the domain (industry, research, or
societal need).", _
"Motivation: why this matters (efficiency, sustainability, cost,
safety).", _
"Proposed idea at a glance: one-sentence value proposition." _
)
' 3) Problem Statement
AddBullets pres, "Problem Statement", _
Array( _
"Clearly define the engineering problem and constraints.", _
"Quantify current limitations (performance, cost, lifecycle).", _
"Scope: what is in/out for this project." _
)
' 4) Objectives
AddBullets pres, "Objectives", _
Array( _
"Objective 1: measurable performance target.", _
"Objective 2: reliability/safety compliance target.", _
"Objective 3: manufacturability or cost reduction goal.", _
"KPIs: efficiency, pressure drop, weight, cost, etc." _
)
' 5) Literature Review / Background
AddBullets pres, "Literature Review / Background", _
Array( _
"Key prior work and benchmarks.", _
"Research gap / limitations in existing solutions.", _
"Your unique angle or hypothesis." _
)
' 6) Proposed Design / Concept
AddBullets pres, "Proposed Design / Concept", _
Array( _
"System overview (diagram/CAD to be inserted).", _
"Working principle and key components.", _
"Assumptions and design envelope (operating conditions)." _
)
' 7) Methodology
AddBullets pres, "Methodology", _
Array( _
"Workflow: Requirements → Concept → Detailed Design → Simulation →
Fabrication → Testing.", _
"Tools: SolidWorks/Inventor, ANSYS/COMSOL, MATLAB/Python, CFD/FEM.", _
"Validation approach: test plan and acceptance criteria." _
)
' 8) Expected Outcomes
AddBullets pres, "Expected Outcomes", _
Array( _
"Anticipated performance improvements (with targets).", _
"Risk & mitigation summary.", _
"Deliverables: CAD, drawings, prototype, test report, code." _
)
' 9) Resources & Budget (table)
AddBudgetTable pres, "Resources & Budget", _
Array("Item", "Qty", "Unit Cost", "Subtotal", "Notes"), _
6
' 10) Timeline (simple visual)
AddTimeline pres, "Timeline (Gantt-style Overview)", _
Array("Requirements", "Design", "Simulation", "Fabrication", "Testing",
"Report")
' 11) Applications & Impact
AddBullets pres, "Applications & Impact", _
Array( _
"Industrial relevance (where it will be used).", _
"Environmental & sustainability impact.", _
"Commercialization/technology transfer potential." _
)
' 12) Conclusion
AddBullets pres, "Conclusion", _
Array( _
"Restate the problem-value link.", _
"Feasibility and readiness to proceed.", _
"Call to action / next steps." _
)
' 13) Q&A
AddLargeCenteredText pres, "Q&A", "Questions?"
MsgBox "Your Mechanical Engineering Proposal deck is ready. Fill in content,
insert CAD/images, and you're set!", vbInformation, "Done"
End Sub
' ---------- Helpers ----------
Private Sub AddBullets(pres As Presentation, titleTxt As String, bullets As
Variant)
Dim sld As Slide, shp As Shape, i As Long
Set sld = pres.Slides.Add(pres.Slides.Count + 1, ppLayoutTitleAndContent)
sld.Shapes.Title.TextFrame.TextRange.Text = titleTxt
Set shp = sld.Shapes.Placeholders(2)
With shp.TextFrame.TextRange
.Text = bullets(LBound(bullets))
.ParagraphFormat.Bullet.Visible = msoTrue
For i = LBound(bullets) + 1 To UBound(bullets)
.InsertAfter vbCrLf & CStr(bullets(i))
Next i
.Font.Size = 20
End With
End Sub
Private Sub AddBudgetTable(pres As Presentation, titleTxt As String, headers As
Variant, _
ByVal rowsTotal As Long)
Dim sld As Slide, tbl As Shape
Dim cols As Long, r As Long, c As Long
cols = UBound(headers) - LBound(headers) + 1
Set sld = pres.Slides.Add(pres.Slides.Count + 1, ppLayoutTitleOnly)
sld.Shapes.Title.TextFrame.TextRange.Text = titleTxt
Set tbl = sld.Shapes.AddTable(rowsTotal, cols, 60, 120,
pres.PageSetup.SlideWidth - 120, 260)
With tbl.Table
' Header row
For c = 1 To cols
.Cell(1, c).Shape.TextFrame.TextRange.Text = headers(c - 1)
.Cell(1, c).Shape.Fill.ForeColor.RGB = RGB(230, 235, 245)
.Cell(1, c).Shape.TextFrame.TextRange.Bold = msoTrue
Next c
' Example last row as total
.Cell(rowsTotal, 1).Shape.TextFrame.TextRange.Text = "TOTAL"
.Cell(rowsTotal, 1).Shape.TextFrame.TextRange.Bold = msoTrue
End With
End Sub
Private Sub AddTimeline(pres As Presentation, titleTxt As String, phases As
Variant)
Dim sld As Slide
Dim i As Long, n As Long
Dim leftPos As Single, topPos As Single, widthBox As Single, heightBox As
Single
Dim gap As Single, arrow As Shape, box As Shape
Set sld = pres.Slides.Add(pres.Slides.Count + 1, ppLayoutTitleOnly)
sld.Shapes.Title.TextFrame.TextRange.Text = titleTxt
' Layout parameters
n = UBound(phases) - LBound(phases) + 1
leftPos = 60
topPos = 150
widthBox = (pres.PageSetup.SlideWidth - 120) / n - 10
If widthBox < 100 Then widthBox = 100
heightBox = 60
gap = 10
' Draw boxes + connecting arrows
For i = 0 To n - 1
Set box = sld.Shapes.AddShape(Type:=msoShapeRoundedRectangle, _
Left:=leftPos + i * (widthBox + gap),
Top:=topPos, _
Width:=widthBox, Height:=heightBox)
With box
.Fill.ForeColor.RGB = RGB(235, 245, 255)
.Line.ForeColor.RGB = RGB(30, 90, 160)
.TextFrame.HorizontalAlignment = ppAlignCenter
.TextFrame.VerticalAlignment = ppAlignCenter
.TextFrame.TextRange.Text = CStr(phases(i))
.TextFrame.TextRange.Font.Size = 16
.TextFrame.TextRange.Font.Bold = msoTrue
End With
If i < n - 1 Then
Set arrow = sld.Shapes.AddConnector(Type:=msoConnectorElbow, _
BeginX:=box.Left + box.Width,
BeginY:=box.Top + box.Height / 2, _
EndX:=box.Left + box.Width + gap,
EndY:=box.Top + box.Height / 2)
arrow.Line.EndArrowheadStyle = msoArrowheadTriangle
arrow.Line.Weight = 1.5
End If
Next i
' Legend for weeks (optional placeholders)
Dim note As Shape
Set note = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 60, topPos +
heightBox + 30, _
pres.PageSetup.SlideWidth - 120, 40)
note.TextFrame.TextRange.Text = "Tip: annotate each phase with dates/weeks
(e.g., Wk1–2, Wk3–5)."
note.TextFrame.TextRange.Font.Italic = msoTrue
note.TextFrame.TextRange.Font.Size = 14
End Sub
Private Sub AddLargeCenteredText(pres As Presentation, titleTxt As String, bigText
As String)
Dim sld As Slide, tb As Shape
Set sld = pres.Slides.Add(pres.Slides.Count + 1, ppLayoutTitleOnly)
sld.Shapes.Title.TextFrame.TextRange.Text = titleTxt
Set tb = sld.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=100, Top:=180,
Width:=pres.PageSetup.SlideWidth - 200, Height:=120)
With tb.TextFrame.TextRange
.Text = bigText
.ParagraphFormat.Alignment = ppAlignCenter
.Font.Size = 40
.Font.Bold = msoTrue
End With
End Sub
