chào mọi người, em có file excel bị lỗi font do style rác nhiều ạ, em có xem qua các bài viết mọi người hướng dẫn code:
Private Const rarApp = "winrar.exe"
Sub PrepareAndRun(ByVal Excel_File As String)
Dim Params As String, filename As String, StartDir As String, ext As String
Dim text As String, text2 As String, text3 As String
Dim Arr, aBuiltInYes(), aBuiltInNo()
Dim lBuiltInYes As Long, lBuiltInNo As Long, i As Long, start As Long, end_ As Long
With CreateObject("Scripting.FileSystemObject")
ext = .GetExtensionName(Excel_File)
If ext <> "xlsm" And ext <> "xlsx" Then Exit Sub
filename = .GetFile(Excel_File).Name
StartDir = .GetFile(Excel_File).ParentFolder.Path
Params = "x -apxl " & """" & Excel_File & """" & " xl\styles.xml"
If RunAndStop(rarApp, Params, StartDir) Then
With .OpenTextFile(StartDir & "\styles.xml")
text = .ReadAll
.Close
End With
.DeleteFile StartDir & "\styles.xml", True
start = InStr(1, text, "<cellStyle name=")
end_ = InStr(1, text, "</cellStyles>")
text2 = Mid(text, start, end_ - start)
text3 = Replace(text2, "/><", "/>" & vbLf & "<")
Arr = Split(text3, vbLf)
For i = LBound(Arr) To UBound(Arr)
If InStr(1, Arr(i), "builtinId") Then
lBuiltInYes = lBuiltInYes + 1
ReDim Preserve aBuiltInYes(1 To lBuiltInYes)
aBuiltInYes(lBuiltInYes) = Arr(i)
Else
lBuiltInNo = lBuiltInNo + 1
ReDim Preserve aBuiltInNo(1 To lBuiltInNo)
aBuiltInNo(lBuiltInNo) = Arr(i)
End If
Next
If lBuiltInNo Then
text = Replace(text, text2, Join(aBuiltInYes, ""))
.CreateTextFile(StartDir & "\styles.xml").Write text
Params = "a -apxl " & """" & Excel_File & """" & " styles.xml"
If RunAndStop(rarApp, Params, StartDir) Then
.DeleteFile StartDir & "\styles.xml", True
MsgBox "Da xoa xong " & lBuiltInNo & " styles rác"
End If
Else
MsgBox "Không có styles rác nào"
End If
End If
End With
End Sub
mà em đã copy vào
Microsoft Visual basic rồi, nhưng ko biết xử lý ntn nữa ạ, mong mọi người giúp em sớm ạ, (em rất dốt món này nên mn chỉ bảo nhiều）
