可以一次處理EXCEL的列高讓它不遮字

 🛠️ 終極解決方案:使用 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


沒有留言:

張貼留言

可以一次處理EXCEL的列高讓它不遮字

 🛠️ 終極解決方案:使用 VBA 巨集(一鍵完美修正)  這個方法完全不需要手動調,它會自動把第 10 列以下有字的地方「自動撐開 + 補上安全距離」,確保預覽和印出來絕對不會切到字。 1. 在 Excel 畫面中,按下鍵盤上的 Alt + F11(會打開一個白色視窗)。 2...