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.


delblank #

Removes blanks created when copying tables in Excel; note it removes all spaces in the table

Sub delBlank()
    Dim shp As shape
    Dim i As Long
    Dim j As Long
   
    On Error GoTo ErrorHandler

    If ActiveWindow.Selection.Type = ppSelectionShapes Then
        For Each shps In ActiveWindow.Selection.ShapeRange
            Set shp = shps
            Exit For
        Next shps
    Else
        MsgBox "There is no table!", vbExclamation
        GoTo dd
    End If

    If shp.HasTable Then
        For i = 1 To shp.Table.Rows.Count
            For j = 1 To shp.Table.Columns.Count
                shp.Table.Rows.Item(i).Cells(j).shape.TextFrame.TextRange.Text = _
                    Replace(shp.Table.Rows.Item(i).Cells(j).shape.TextFrame.TextRange.Text, " ", "")
                shp.Table.Rows.Item(i).Cells(j).shape.TextFrame.TextRange.Text = _
                    Replace(shp.Table.Rows.Item(i).Cells(j).shape.TextFrame.TextRange.Text, " ", "")
                shp.Table.Rows.Item(i).Cells(j).shape.TextFrame.TextRange.Text = _
                    Replace(shp.Table.Rows.Item(i).Cells(j).shape.TextFrame.TextRange.Text, vbCr, "")
            Next j
        Next i
    End If

dd:
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical
    Resume dd
End Sub