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