Powerpoint

Hover effect

Creating mouse hover effect in excel VBA userform #

Take #1 #

When did VB6—the foundation of VBA—officially lose technical support? It’s quite unfortunate that one of the few programming languages familiar and accessible to non-developers and marketers at work is based on technology from decades ago.

Compared to today’s technologies, it might be natural that it shows its limitations. Today, I’m attempting a workaround to implement a mouse hover effect on an object used as a button.

MacroToolkit - Excel

MacroToolkit - Excel #

What is it? #

Over the years of working extensively with Excel, I created macros for frequently used tasks. Although these were personal macros, I once shared them publicly hoping they might help others. However, whether offered for free or as paid tools, they never gained much traction, so I eventually withdrew all of them.

macrotoolkit


Key Point #

The main value lies not so much in any individual feature, but in gathering various macros into one place for easier management. To handle this, I used a UserForm, but surprisingly, the VB6 UserForm is quite outdated and lacks many features that we now take for granted—like support for PNG images, for example.
→ Nonetheless, it serves well enough for organizing the macros.

MacroToolkit - powerpoint

What is it? #

Since PowerPoint often requires manual work tailored to each specific scenario, it’s harder to create standardized features compared to Excel. For that reason, I’ve gathered useful code snippets I found through extensive web surfing. Feel free to review and modify them to fit your needs.

ppt


Key Point #

Instead of relying on UserForm, I made active use of the Ribbon menu to enhance usability.

Sctipt - table

Sctipt - table #

What is it? #

Useful functions for handling tables.


Make Table #

Creates frequently used table templates.

Sub tableMaker(control As IRibbonControl)

    On Error GoTo Err_Check

    Dim myt As shape
    Dim idx As Integer
    Dim cnum As Integer
    Dim rnum As Integer
    Dim c As Integer
    Dim r As Integer

    idx = ActiveWindow.View.slide.slideIndex
    Set myt = ActivePresentation.Slides(idx).Shapes.AddTable(4, 4)

    cnum = myt.Table.Columns.Count
    rnum = myt.Table.Rows.Count

    With myt.Table
        For c = 1 To cnum
            For r = 1 To rnum
                If r = 1 Then
                    .cell(r, c).Borders(ppBorderTop).ForeColor.RGB = RGB(64, 64, 64)
                    .cell(r, c).Borders(ppBorderTop).Weight = 0.5
                    .cell(r, c).Borders(ppBorderBottom).ForeColor.RGB = RGB(64, 64, 64)
                    .cell(r, c).Borders(ppBorderBottom).Weight = 0.5
                    .cell(r, c).shape.Fill.ForeColor.RGB = RGB(242, 242, 242)
                Else
                    .cell(r, c).shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
                End If

                If c < cnum Then
                    .cell(r, c).Borders(ppBorderRight).ForeColor.RGB = RGB(191, 191, 191)
                    .cell(r, c).Borders(ppBorderRight).Weight = 0.5
                End If

                If r > 1 And r < rnum Then
                    .cell(r, c).Borders(ppBorderBottom).ForeColor.RGB = RGB(191, 191, 191)
                    .cell(r, c).Borders(ppBorderBottom).Weight = 0.5
                End If

                If r = rnum Then
                    .cell(r, c).Borders(ppBorderBottom).ForeColor.RGB = RGB(64, 64, 64)
                    .cell(r, c).Borders(ppBorderBottom).Weight = 0.5
                End If

                .cell(r, c).shape.TextFrame.TextRange.Font.size = 12
                .cell(r, c).shape.TextFrame.TextRange.Font.Bold = msoFalse
                .cell(r, c).shape.TextFrame.TextRange.Font.Name = "맑은 고딕"
                .cell(r, c).shape.TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
                .cell(r, c).shape.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
                .cell(r, c).shape.TextFrame.VerticalAnchor = msoAnchorMiddle

            Next r
        Next c
    End With

    Exit Sub

Err_Check:
    If Err.Number <> 0 Then
        MsgBox "오류번호 : " & Err.Number & vbCr & _
        "오류내용 : " & Err.Description, vbCritical, "오류 발생"
    End If

End Sub

Table Size #

Adjusts table size via UserForm. → Refer to the .PPAM file for the userForm code.

Making Keyboard Shortcut

Making Keyboard Shortcut #

what is it? #

If you want to create a shortcut key to run an Excel macro, you can write the code as follows. The example below applies the shortcut key when the userform is launched.

sample #

You can set macro shortcut key with below:
% : shift, ^ : control, + : alt

Sub showMenu()
    MyMacros.Show

    'shift + alt + 1
    Application.OnKey "%+1", "lineGrayDblClick" 'macro name
    'shift + alt + 2
    Application.OnKey "%+2", "lineBlackDblClick"
    'shift + alt + 3
    Application.OnKey "%+3", "lineBlackBoldDblClick"
    'shift + alt + 4
    Application.OnKey "%+4", "colorFill"
End Sub

 
original post (Kor)

Script - Cell format

Script - Cell format #

cell outline #

lineGray {ALT + SHIFT + 1} #

linegray
Remove the guidelines and create the gray line.
→ click : outskirt of the cell range selected.
→ double click : entire cell of the cell range selected.


lineBlack {ALT + SHIFT + 2} #

lineBlack
Remove the guidelines and create the black line.
→ click : outskirt of the cell range selected.
→ double click : entire cell of the cell range selected.

Sctipt - color

Sctipt - color #

What is it? #

Useful functions for handling color.


RGB_color #

Displays RGB values of the selected shape via UserForm. → Refer to the .PPAM file for the userForm code.


Color_palette #

Creates a color palette in the slide master - newly added feature.

Sub pal2()    
    Dim mySlideMaster As Master
    Dim left As Integer
    Dim top As Integer
    Dim size As Integer
    Dim idx As Integer
    Dim rgb1 As Long
    Dim rgb2 As Long
    Dim hexcolor As String
    Dim colred As Integer
    Dim colgreen As Integer
    Dim colblue As Integer
    Dim newcol As String
    Dim pagenum As Integer

    On Error GoTo Err_Check

    Set mySlideMaster = Application.ActivePresentation.slideMaster

    If MsgBox("do you wanna set default?", vbYesNo) = vbNo Then
        If MsgBox("do you wanna use HEX color data?", vbYesNo) = vbYes Then
            On Error GoTo Err_Check
            hexcolor = InputBox("your hex color")            
            
            newcol = HexToRGB(hexcolor)
            colred = Replace(Split(newcol, ",")(0), " ", "")
            colgreen = Replace(Split(newcol, ",")(1), " ", "")
            colblue = Replace(Split(newcol, ",")(2), " ", "")
            
            idx = InputBox("index")
        Else
            On Error GoTo Err_Check
            colred = InputBox("type R")
            colgreen = InputBox("type G")
            colblue = InputBox("type B")
            idx = InputBox("index")
        
            If colred < 0 Or colgreen < 0 Or colblue < 0 Or idx <= 0 Then
                MsgBox "Invalid input values", vbCritical
                GoTo Err_Check2
            End If
        End If

        top = 0
        left = -25
        size = 20
        
        With mySlideMaster.Shapes.AddShape(Type:=msoShapeRectangle, left:=left, top:=topcal(idx, size), width:=size, height:=size)
            .Fill.ForeColor.RGB = RGB(colred, colgreen, colblue)
            .line.Visible = msoFalse
        End With
    Else
        rgb1 = RGB(0, 63, 104)
        rgb2 = RGB(237, 116, 35)

        For x = 1 To 4
            counter = counter + 1
            With mySlideMaster.Shapes.AddShape(Type:=msoShapeRectangle, left:=-25, top:=((x - 1) * 20) + (ConvertCmToPoint(0.3) * (x - 1)), width:=20, height:=20)
                If x = 1 Then
                    .Fill.ForeColor.RGB = rgb1
                ElseIf x = 2 Then
                    .Fill.ForeColor.RGB = rgb2
                Else
                    .Fill.ForeColor.RGB = RGB(0, 0, 0)
                End If
                .line.Visible = msoFalse
            End With
        Next x
    End If

    Exit Sub

Err_Check:
    If Err.Number <> 0 Then
        MsgBox "오류번호 : " & Err.Number & vbCr & "오류내용 : " & Err.Description, vbCritical, "오류"
    End If
    Exit Sub

Err_Check2:
    MsgBox "you have wrong input value", vbCritical, "잘못된 입력"
    Exit Sub
End Sub

Function topcal(idx As Integer, size As Integer)
    If idx = 1 Then
        topcal = 0
    Else
        topcal = ((idx - 1) * size) + (ConvertCmToPoint(0.3) * (idx - 1))
    End If
End Function


Function ConvertPointToCm(ByVal pnt As Double) As Double
    ConvertPointToCm = pnt * 0.03527778
End Function


Function ConvertCmToPoint(ByVal cm As Double) As Double
    ConvertCmToPoint = cm * 28.34646
End Function


Function HexToRGB(hexcolor As String) As String
    Dim r As Integer
    Dim G As Integer
    Dim B As Integer
    Dim newrgbcolor As String

    On Error GoTo Err_Check

    hexcolor = Replace(hexcolor, "#", "")
    hexcolor = Right$("000000" & hexcolor, 6)
    r = val("&H" & Mid(hexcolor, 1, 2))
    G = val("&H" & Mid(hexcolor, 3, 2))
    B = val("&H" & Mid(hexcolor, 5, 2))

    newrgbcolor = r & ", " & G & ", " & B
    Debug.Print newrgbcolor

    HexToRGB = newrgbcolor

    Exit Function

Err_Check:
    If Err.Number <> 0 Then
        MsgBox "오류번호 : " & Err.Number & vbCr & "오류내용 : " & Err.Description, vbCritical, "오류"
    End If
    Exit Function
End Function

Script - Value format

Script - Value format #

Number format #

formatNum_normal #

formatNum_normal
Change to a normal number format.
[yes - with right padding(accounting)] #,##0_-;[Red]-#,##0_-;-_-
[no - without right padding] #,##0;[Red]-#,##0;-


formatNum_thousand #

formatNum_thousand
Change in a thousand unit number format.
[yes - with right padding(accounting)] #,##0,-;[Red]-#,##0,-;-_-
[no - without right padding] #,##0,;[Red]-#,##0,;-


formatNum_mil #

formatNum_mil
Change in a million unit number format.
[yes - with right padding(accounting)] #,##0,,-;[Red]-#,##0,,-;-_-
[no - without right padding] #,##0,,;[Red]-#,##0,,;-

Sctipt - text

Sctipt - text #

What is it? #

Useful functions for handling text.


Text arrange #

Adjusts letter spacing of Malgun Gothic font to 0.3.


zeromargin #

Sets margins of text boxes or shapes to zero.


Script - Function

Script - Function #

savebysheetname #

savebysheetname
Save each sheet as a separate file.


coloredRowDel #

coloredRowDel
Delete the row of the colored cell from the selected area.


Handling Duplication #

checkDuplication #

checkduplication
In the selected area, color the redundant value.


removeDuplicates #

removeduplicates
Remove the duplicate value from the value of the selected area and make and paste a new sheet.


clearFilter #

clearFilter
clear all filters.