自動調整表格中的單元格大小

Question

如何自動調整PowerPoint表格中列寬或行高的大小？

編輯：我用PowerPoint 2010中的工作，我想是這樣的：

Sub table_fix() 
Dim icol As Integer, irow As Integer, minW As Single, minH As Single 
With ActiveWindow.Selection.ShapeRange(1).table 
    For icol = 1 To .Columns.Count 
    For irow = 1 To .Rows.Count 
    With .Cell(irow, icol).Shape.TextFrame 
    If minW = 0 Then minW = .TextRange.BoundWidth + .MarginLeft + .MarginRight 
    If minW < .TextRange.BoundWidth + .MarginLeft + .MarginRight Then minW = .TextRange.BoundWidth + .MarginLeft + .MarginRight 
    End With 
    Next 
    .Columns(icol).Width = minW 
    Next 
End With 
With ActiveWindow.Selection.ShapeRange(1).table 
    For irow = 1 To .Rows.Count 
    For icol = 1 To .Columns.Count 
    With .Cell(irow, icol).Shape.TextFrame 
    If minH = 0 Then minH = .TextRange.BoundHeight + .MarginTop + .MarginBottom 
    If minH < .TextRange.BoundHeight + .MarginTop + .MarginBottom Then minH = .TextRange.BoundHeight + .MarginTop + .MarginBottom 
    End With 
    Next 
    .Rows(irow).Height = minH 
    Next 
End With 
End Sub 

此代碼不能解決所有的列寬和所有行高度。它有一些混亂的列，當列窄和高時，要調整列大小，有時會在某些數字上添加隨機空格。

我希望能模擬「通過雙擊邊框來調整單元格大小」。我相信我需要用BoundWidth和BoundHeight進行某種迭代計算，還是2010有我最初搜索的功能？

編輯2：我已經分手的代碼進行測試：

Sub IT() 
Dim icol As Integer, irow As Integer, minW As Single, minH As Single 
Call max_it 
Call size_it 
End Sub 

Function max_it() 
With ActiveWindow.Selection.ShapeRange(1).table 
    For icol = 1 To .Columns.Count 
    .Columns(icol).Width = 1000 
    Next 
End With 
End Function 

Function size_it() 
With ActiveWindow.Selection.ShapeRange(1).table 
    For icol = 1 To .Columns.Count 
    For irow = 1 To .Rows.Count 
    With .Cell(irow, icol).Shape.TextFrame 
    If minW = 0 Then minW = .TextRange.BoundWidth + .MarginLeft + .MarginRight 
    If minW < .TextRange.BoundWidth + .MarginLeft + .MarginRight Then minW = .TextRange.BoundWidth + .MarginLeft + .MarginRight 
    End With 
    Next 
    .Columns(icol).Width = minW 
    minW = 0 
    If icol < .Columns.Count Then .Columns(icol + 1).Width = 1000 
    Next 
    For irow = 1 To .Rows.Count 
    For icol = 1 To .Columns.Count 
    With .Cell(irow, icol).Shape.TextFrame 
    If minH = 0 Then minH = .TextRange.BoundHeight + .MarginTop + .MarginBottom 
    If minH < .TextRange.BoundHeight + .MarginTop + .MarginBottom Then minH = .TextRange.BoundHeight + .MarginTop + .MarginBottom 
    End With 
    Next 
    .Rows(irow).Height = minH 
    Next 
End With 
End Function 

當我運行max_it和size_it分開，但它確實我想要的東西，但如果我把它叫做後對方運行以下兩個功能忽略max_it部分，因此size_it將不返回正確的BoundWidth如果單元格「窄和高」。

我可能有一些初學者的錯誤，如：VBA很聰明，意識到第一max_it變化將通過size_it返工，因此忽略該代碼

Answer 1

我搜索互聯網上的位，並做了一些R（？） & D，發現這個代碼在桌子上工作。場景是有一張幻燈片和一張表格，並且選中一行。

Sub Spacer_Row() 'backup 
Dim Sld As Slide 
Dim Shp As Shape 
Dim tabs As table 
Dim lRow As Long 
Dim lCol As Long 
'Table row formatting 
On Error GoTo Select_Object 
With ActiveWindow.Selection 
If .ShapeRange.Type = msoTable Then 
Set tabs = .ShapeRange.table 
For lRow = 1 To tabs.Rows.Count 
For lCol = 1 To tabs.Columns.Count 
    If tabs.Cell(lRow, lCol).Selected Then 
    With tabs.Cell(lRow, lCol).Shape 
    tabs.Cell(lRow, lCol).Shape.TextFrame2.MarginBottom = 0.7 
    tabs.Cell(lRow, lCol).Shape.TextFrame2.MarginTop = 0.6 
    tabs.Cell(lRow, lCol).Shape.TextFrame.TextRange.Font.Size = 1 
    tabs.Rows(lRow).Height = 0.2 
    tabs.Cell(lRow, lCol).Shape.Fill.ForeColor.RGB = RGB(255, 255, 255) 
    End With 
    End If 
Next 
Next 
Exit Sub 
End If 
Select_Object: 
MsgBox "Select a row to resize" 'Error box asking to select a row 
End With 
End Sub