'引入兩個函式，用來解決utf8檔案 讀寫
Public Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByRef lpMultiByteStr As Any, _
ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long) As Long
Public Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByRef lpMultiByteStr As Any, _
ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As String, _
ByVal lpUsedDefaultChar As Long) As Long
Public Const CP_UTF8 = 65001
' 將輸入文本寫進UTF8格式的文本檔案
' 輸入
' strInput：文本字串
' strFile：保存的UTF8格式檔案路徑
' bBOM：True表示檔案帶"EFBBBF"頭，False表示不帶
Sub WriteUTF8File(strInput As String, strFile As String, Optional bBOM As Boolean = False)
Dim bByte As Byte
Dim ReturnByte() As Byte
Dim lngBufferSize As Long
Dim lngResult As Long
Dim TLen As Long
' 判斷輸入字串是否為空
If Len(strInput) = 0 Then Exit Sub
On Error GoTo errHandle
' 判斷檔案是否存在，如存在則洗掉
If Dir(strFile) <> "" Then Kill strFile
TLen = Len(strInput)
lngBufferSize = TLen * 3 + 1
ReDim ReturnByte(lngBufferSize - 1)
lngResult = WideCharToMultiByte(CP_UTF8, 0, CStr(StrPtr(strInput)), TLen, _
ReturnByte(0), lngBufferSize, vbNullString, 0)
If lngResult Then
lngResult = lngResult - 1
ReDim Preserve ReturnByte(lngResult)
Open strFile For Binary As #1
If bBOM = True Then
bByte = 239
Put #1, , bByte
bByte = 187
Put #1, , bByte
bByte = 191
Put #1, , bByte
End If
Put #1, , ReturnByte
Close #1
End If
Exit Sub
errHandle:
MsgBox Err.Description, , "錯誤 - " & Err.Number
End Sub
Function StrReplace(s As String, p As String, r As String) As String
Dim re
Set re = CreateObject("VBScript.RegExp")
re.IgnoreCase = True
re.Global = True
re.Pattern = p
StrReplace = re.Replace(s, r)
End Function
Function bTest(ByVal s As String, ByVal p As String) As Boolean
Dim re
Set re = CreateObject("VBScript.RegExp")
re.IgnoreCase = False '設定是否匹配大小寫
re.Pattern = p
bTest = re.Test(s)
End Function
Sub achievement_lua()
Dim currentPath As String
Dim fileName1 As String
Dim strContent As String
Dim str As String
Dim str1 As String
Dim splitStr As String
Dim lineArray() As String
Dim lineStr As Variant
Dim valueArray() As String
Dim tmpStr As String
Dim i, j, x, y, z, maxRow, maxRow2 As Integer
Dim pSheet As Worksheet
Dim taskId As String
Dim dict
Set dict = CreateObject("Scripting.Dictionary")
Dim dict2
Set dict2 = CreateObject("Scripting.Dictionary")
splitStr = Chr(10)
currentPath = Application.ActiveWorkbook.Path + "\"
fileName1 = currentPath + "achievement.lua"
'==================================================成就=========================================
Set pSheet = ActiveWorkbook.Worksheets("成就")
'pSheet.UsedRange.Select
maxRow = pSheet.UsedRange.Rows.Count
'MsgBox maxRow
str = ""
i = 0
For i = 2 To maxRow
str = str & "{" & splitStr
If CStr(pSheet.Cells(i, 1).Value) = "" Then
Else
For j = 1 To 21
If CStr(pSheet.Cells(1, j).Value) = "" Then
Else
Key = CStr(pSheet.Cells(1, j))
Value = CStr(pSheet.Cells(i, j))
If (j = 18 Or j = 19 Or j = 21) Then
str = str & " " & Key & "=" & splitStr & Value & splitStr
Else
str = str & " " & Key & "=" & Value & splitStr
End If
End If
Next j
End If
str = str & "}" & splitStr & splitStr
Next i
strContent = strContent & str
WriteUTF8File strContent, fileName1, False
MsgBox "已經成功匯出achievement.lua資料到 " & fileName1
End Sub
提示缺少sub或者function，請問哪里出錯了？
uj5u.com熱心網友回復：
兩個 API宣告 那兒，把 PtrSafe 去掉。寫成定樣的：
Public Declare Function MultiByteToWideChar Lib .......
Public Declare Function WideCharToMultiByte Lib ........
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/99707.html
標籤：VBA
上一篇：一份關于編程入門的英文作業，求教