Contents ...
udn網路城邦
可以一次處理EXCEL的列高讓它不遮字
2026/11/01 09:27
瀏覽11
迴響0
推薦0
引用0

 🛠️ 終極解決方案:使用 VBA 巨集(一鍵完美修正)
 這個方法完全不需要手動調,它會自動把第 10 列以下有字的地方「自動撐開 + 補上安全距離」,確保預覽和印出來絕對不會切到字。
1. 在 Excel 畫面中,按下鍵盤上的 Alt + F11(會打開一個白色視窗)。
2. 點擊上方選單的【插入】➔【模組】。 
3. 把下面這段vba 程式碼複製並貼上到右邊的空白大框框中:  


Sub 強制換行緩衝版()
    Dim ShellApp As Object
    Dim FolderPath As String
    Dim FileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Long, lastRow As Long, colNum As Long
    Dim currentLastRow As Long
    Dim cell As Range
    Dim targetRange As Range
    
    讓使用者彈出視窗選擇那檔案所在的資料夾
    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "請選擇存放Excel 的資料夾", 0)
    If ShellApp Is Nothing Then Exit Sub
    FolderPath = ShellApp.Self.Path & "\"
    
    關閉畫面更新與警告視窗,提升執行速度
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    尋找資料夾內的所有 Excel 檔案
    FileName = Dir(FolderPath & "*.xls*")
    
    Do While FileName <> ""
        打開檔案
        Set wb = Workbooks.Open(FolderPath & FileName)
        
        對該檔案中的每一個工作表(分頁)進行處理
        For Each ws In wb.Worksheets
            
            ?? 核心修正 1:同時檢查 A 欄到 Z 欄(第 1 到第 26 欄),找出真正最底下的那一行
            lastRow = 0
            For colNum = 1 To 26 1代表A欄,26代表Z欄
                currentLastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row
                If currentLastRow > lastRow Then
                    lastRow = currentLastRow
                End If
            Next colNum
            
            如果有資料,且最後一行大於或等於第 10 列才處理
            If lastRow >= 10 Then
                
                ?? 核心修正 2:將檢查範圍擴大到第 10 列到最後一列的 A 欄到 Z 欄
                Set targetRange = ws.Range(ws.Cells(10, "A"), ws.Cells(lastRow, "Z"))
                
                檢查 A 到 Z 欄的每個儲存格,並在末尾補上一個換行 (Chr(10))
                For Each cell In targetRange
                    If Not IsError(cell.Value) Then
                        確保儲存格不是空的,且不是公式
                        If cell.Value <> "" And Not cell.HasFormula Then
                            如果文字的最後一個字還不是換行符號,就加上去
                            If Right(cell.Value, 1) <> Chr(10) Then
                                cell.Value = cell.Value & Chr(10)
                            End If
                        End If
                    End If
                Next cell
                
                補完換行後,讓 Excel 自動啟用「自動換行」並調整列高
                For i = 10 To lastRow
                    If ws.Rows(i).EntireRow.Hidden = False Then
                        ws.Rows(i).Cells(1).EntireRow.WrapText = True 確保開啟自動換行
                        ws.Rows(i).AutoFit 自動調整列高
                         ws.Rows(i).RowHeight = ws.Rows(i).RowHeight + 5 補上 5 點列印緩衝
                    End If
                Next i
                
            End If
        Next ws
        
        儲存並關閉檔案
        wb.Close SaveChanges:=True
        
        繼續搜尋下一個檔案
        FileName = Dir()
    Loop
    
    重新開啟畫面更新
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "大功告成!資料檔案的 A 到 Z 欄已全面補上換行緩衝並自動補上 5 點列印緩衝調整完畢!", vbInformation, "完成通知"
End Sub


全站分類:知識學習| 其他
自訂分類:不分類
下一則: 我有個數學題:60除1.5=30, 60除1.5=40
發表迴響

會員登入