- ©«¤l
- 109
- ¥DÃD
- 2
- ºëµØ
- 0
- ¿n¤À
- 114
- ÂI¦W
- 0
- §@·~¨t²Î
- Win7 Win10
- ³nÅ骩¥»
- Office 2019 WPS
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ²`¦`
- µù¥U®É¶¡
- 2013-2-2
- ³Ì«áµn¿ý
- 2024-8-30
|
¦^´_ 1# lionliu
¤£¦n·N«ä¡A2#ªº¥N½X¦³¿ù»~¡A©Ò¥H¦b3#«·sªþ¤W·sªº¥N½X¡C½Ð·s¼W¤@Ó¼Ò¶ô¡A±N¤U±ªº¥N½XÖ߶K¨ì·sªº¼Ò¶ô¸Ì¡G- #If VBA7 Then
- Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" _
- (ByVal CodePage As Long, ByVal dwFlags As Long, _
- ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, _
- ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As Long, _
- Optional ByVal lpDefaultChar As Long = 0, Optional ByVal lpUsedDefaultChar As Long = 0) As Long
- #Else
- Private Declare Function WideCharToMultiByte Lib "kernel32" _
- (ByVal CodePage As Long, ByVal dwFlags As Long, _
- ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _
- ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
- Optional ByVal lpDefaultChar As Long = 0, Optional ByVal lpUsedDefaultChar As Long = 0) As Long
- #End If
- Public Sub TestSave()
- Dim FileName As Variant
-
- FileName = Application.GetSaveAsFilename(FileFilter:="UTF-8 Text File,*.TXT", FilterIndex:=1)
- If VarType(FileName) = vbString Then
- If Len(Dir(FileName, vbHidden Or vbReadOnly Or vbSystem)) Then
- If MsgBox("¤åÀɤw¦s¦b¡A¬O§_´_¼g¦¹¤åÀÉ¡H", vbYesNo) = vbNo Then Exit Sub
- SetAttr FileName, vbNormal
- Kill FileName
- If Len(Dir(FileName, vbHidden Or vbReadOnly Or vbSystem)) Then
- MsgBox "¿ù»~¡G" & vbCrLf & "µLªk«O¦s¬°«ü©wªº¤å¥ó¦W¡A¤å¥ó³Q¦û¥Î©ÎÅv¤£¤¹³\¡C", vbCritical
- Exit Sub
- End If
- End If
- MsgBox "·í«e¤u§@ªí""" & ActiveSheet.Name & """¥t¦s¬°UTF8 Text¤åÀÉ" & IIf(SaveAsUTF8Text(FileName), "¦¨¥\¡I", "¥¢±Ñ¡I"), vbInformation
- End If
- End Sub
- Public Function SaveAsUTF8Text(ByVal FileName As String) As Boolean
- Dim FileTemp As String
- Dim wkIndex As Long
- Dim lFile As Long
- Dim bytArr() As Byte
- Dim bytUTF8() As Byte
- Dim WB As Workbook
- Dim DisplayAlerts As Boolean, ScreenUpdating As Boolean
-
- On Error Resume Next
-
- DisplayAlerts = Application.DisplayAlerts: ScreenUpdating = Application.ScreenUpdating
- Application.DisplayAlerts = False: Application.ScreenUpdating = False
- wkIndex = ActiveSheet.Index
- FileTemp = GetTempFileName(FileName, "*.XLS")
- ThisWorkbook.SaveCopyAs FileTemp
- Set WB = Workbooks.Open(FileTemp)
- If Not (WB Is Nothing) Then
- WB.Sheets(wkIndex).SaveAs FileName:=FileName, FileFormat:=xlUnicodeText
- WB.Close SaveChanges:=False
- Kill FileTemp
- lFile = FileLen(FileName)
- If lFile > 0 Then
- If lFile > 2 Then
- ReDim bytArr(0 To lFile - 3)
- lFile = FreeFile
- Open FileName For Binary As lFile
- Get lFile, 3, bytArr()
- Close lFile
- Kill FileName
- lFile = WideCharToMultiByte(65001, 0, VarPtr(bytArr(0)), (UBound(bytArr) + 1) \ 2, 0, 0)
- ReDim bytUTF8(0 To 2 + IIf(lFile > 0, lFile, 0))
- If lFile > 0 Then WideCharToMultiByte 65001, 0, VarPtr(bytArr(0)), (UBound(bytArr) + 1) \ 2, VarPtr(bytUTF8(3)), lFile
- Else
- ReDim bytUTF8(0 To 2)
- End If
- bytUTF8(0) = &HEF: bytUTF8(1) = &HBB: bytUTF8(2) = &HBF
- lFile = FreeFile
- Open FileName For Binary As lFile
- Put lFile, , bytUTF8()
- Close lFile
- SaveAsUTF8Text = True
- End If
- End If
- Application.DisplayAlerts = DisplayAlerts: Application.ScreenUpdating = ScreenUpdating
- End Function
- Private Function GetTempFileName(ByVal FileName As String, Optional ByVal FileType As String) As String
- Dim I As Long
-
- If Len(FileType) Then
- I = InStrRev(FileType, ".")
- If I > 0 Then
- If I = Len(FileType) Then
- FileType = ".XLS"
- Else
- FileType = Mid$(FileType, I)
- End If
- Else
- FileType = "." & FileType
- End If
- Else
- FileType = ".XLS"
- End If
- I = InStrRev(FileName, ".")
- If I > 0 Then FileName = Left$(FileName, I - 1)
- I = 1
- Do While Len(Dir(FileName & I & FileType, vbReadOnly Or vbHidden Or vbSystem Or vbDirectory))
- I = I + 1
- Loop
- GetTempFileName = FileName & I & FileType
- End Function
½Æ»s¥N½X ¹B¦æ§»"TestSave"±N·|§â·í«eªº¤u§@ªí«O¦s¬°«ü©wªº¤åÀÉ¡C |
|