2016-08-26 2 views
2

Je travaille à l'écriture d'un script pour la génération de rapports nécessitant un format de ligne de 80 octets.
Actuellement, mon script formate correctement tous les champs, les concatène en une seule colonne et supprime le reste. Cette colonne concaténée comporte des espaces séparant les champs qui ne peuvent pas être supprimés lors de leur sauvegarde. Tout cela est fait sur une version 64 bits d'Excel 2016 sur Windows 10.
Comment sauvegarder le fichier sous forme de fichier texte codé en UTF-8?Enregistrer la feuille au format TXT avec codage UTF-8

+0

Assurez-vous que "ScriptUtils.ByteArray" est dans la liste de référence goto Outils -> Références et recherchez ScriptUtils.ByteArray – HA560

+1

@ HA560 merci de suggérer que. J'ai obtenu le script de [ici] (http://www.motobit.com/help/scptutl/cm119.htm) et j'ai juste réalisé que je suis supposé installer leur [ScriptUtilities] (http: //www.motobit. com/help/scptutl/default.htm) logiciel. EDIT: Merde. Cela coûte de l'argent. – drdb

+0

Vous pouvez créer des tableaux d'octets dans vba sans utilitaire acheté. Beaucoup d'exemples utilisant StrConv, vbUnicode et les tableaux de type Byte. – dbmitch

Répondre

0

J'ai fini par écrire un script AHK qui ouvre Notepad ++, modifie le codage, enregistre le fichier et le ferme. Pas aussi élégant que je l'aurais espéré, mais ça fait le boulot.

+0

Mis à jour le code en réponse - fonctionne pour Office 64 bits – dbmitch

+0

Awesome! Je vais l'essayer. – drdb

0

Code VOICI de cette feuille de calcul d'échantillon modifié pour Office 64 bits

UTFTest.bas

' Converting a VBA string to an array of bytes in UTF-8 encoding 

' $Date: 2015-06-30 10:05Z $ 
' $Original Author: David Ireland $ 

' Copyright (C) 2015 DI Management Services Pty Limited 
' <http://www.di-mgt.com.au> <http://www.cryptosys.net> 

Option Explicit 
Option Base 0 

''' Extract a set of VBA "Unicode" strings from Excel sheet, encode in UTF-8 and display details 
Public Sub ShowStuff() 
    Dim strData As String 

    ' Plain ASCII 
    ' "abc123" 
    ' U+0061, U+0062, U+0063, U+0031, U+0032, U+0033 
    ' EXCEL: Get value from cell A1 
    strData = Worksheets("Sheet1").Cells(1, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(1, 2) 
    ProcessString (strData) 

    ' Spanish 
    ' LATIN SMALL LETTER[s] [AEIO] WITH ACUTE and SMALL LETTER N WITH TILDE 
    ' U+00E1, U+00E9, U+00ED, U+00F3, U+00F1 
    ' EXCEL: Get value from cell A3 
    strData = Worksheets("Sheet1").Cells(3, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(3, 2) 
    ProcessString (strData) 

    ' Japanese 
    ' "Hello" in Hiragana characters is KO-N-NI-TI-HA (Kon'nichiwa) 
    ' U+3053 (hiragana letter ko), U+3093 (hiragana letter n), 
    ' U+306B (hiragana letter ni), U+3061 (hiragana letter ti), 
    ' and U+306F (hiragana letter ha) 
    ' EXCEL: Get value from cell A5 
    strData = Worksheets("Sheet1").Cells(5, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(5, 2) 
    ProcessString (strData) 

    ' Chinese 
    ' CN=ben (U+672C), C= zhong guo (U+4E2D, U+570B), OU=zong ju (U+7E3D, U+5C40) 
    ' EXCEL: Get value from cell A7 
    strData = Worksheets("Sheet1").Cells(7, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(7, 2) 
    ProcessString (strData) 

    ' Hebrew 
    ' "abc" U+0061, U+0062, U+0063 
    ' SPACE U+0020 
    ' [NB right-to-left order] 
    ' U+05DB HEBREW LETTER KAF 
    ' U+05E9 HEBREW LETTER SHIN 
    ' U+05E8 HEBREW LETTER RESH 
    ' SPACE "f123" U+0066 U+0031 U+0032 U+0033 
    ' EXCEL: Get value from cell A9 
    strData = Worksheets("Sheet1").Cells(9, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(9, 2) 
    ProcessString (strData) 

End Sub 

Public Function ProcessString(strData As String) 
    Dim abData() As Byte 
    Dim strOutput As String 

    Debug.Print strData ' This should show "?" for non-ANSI characters 

    strOutput = Utf8BytesFromString(strData) 

    abData = strOutput 
    ' Reset array width to Actual Number of Bytes 
    ReDim Preserve abData(Len(strOutput) - 1) 

    Debug.Print bv_HexFromBytesSp(abData) 

    Debug.Print "Strlen=" & Len(strData) & " chars; utf8len=" & Len(strOutput) & " bytes" 

End Function 

''' Returns hex-encoded string from array of bytes (with spaces) 
''' E.g. aBytes(&HFE, &HDC, &H80) will return "FE DC 80" 
Public Function bv_HexFromBytesSp(aBytes() As Byte) As String 
    Dim i As Long 

    If Not IsArray(aBytes) Then 
     Exit Function 
    End If 

    For i = LBound(aBytes) To UBound(aBytes) 
     If (i > 0) Then bv_HexFromBytesSp = bv_HexFromBytesSp & " " 
     If aBytes(i) < 16 Then 
      bv_HexFromBytesSp = bv_HexFromBytesSp & "0" & Hex(aBytes(i)) 
     Else 
      bv_HexFromBytesSp = bv_HexFromBytesSp & Hex(aBytes(i)) 
     End If 
    Next 

End Function 

et API convertis Win64 appelle

' basUtf8FromString 

' Written by David Ireland DI Management Services Pty Limited 2015 
' <http://www.di-mgt.com.au> <http://www.cryptosys.net> 

Option Explicit 

' CodePage constant for UTF-8 
Private Const CP_UTF8 = 65001 

#If Win64 Then 

    Private Declare PtrSafe Function GetACP Lib "Kernel32"() As LongPtr 

    Private Declare PtrSafe Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As LongPtr, _ 
     ByVal dwflags As LongPtr, ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As LongPtr, _ 
     ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As LongPtr 

    Private Declare PtrSafe Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As LongPtr, _ 
     ByVal dwflags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, _ 
     ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, _ 
     lpUsedDefaultChar As LongPtr) As LongPtr 

#Else 

    Private Declare PtrSafe Function GetACP Lib "Kernel32"() As Long 

    Private Declare PtrSafe Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As Long, _ 
     ByVal dwflags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _ 
     ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long 

    Private Declare PtrSafe 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, ByVal lpDefaultChar As Long, _ 
     lpUsedDefaultChar As Long) As Long 

#End If 

''' Return byte array with VBA "Unicode" string encoded in UTF-8 
Public Function Utf8BytesFromString(strInput As String) As String 
    Dim nBytes  As LongPtr 
    Dim pwz   As LongPtr 
    Dim pwzBuffer As LongPtr 

    Dim sBuffer  As String 

    ' Get length in bytes *including* terminating null 
    pwz = StrPtr(strInput) 
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&) 

    sBuffer = String$(nBytes + 1, vbNullChar) 
    pwzBuffer = StrPtr(sBuffer) 

    nBytes = WideCharToMultiByte(CP_UTF8, 0&, pwz, -1, pwzBuffer, Len(sBuffer), ByVal 0&, ByVal 0&) 
    Utf8BytesFromString = Left$(sBuffer, nBytes - 1) 
End Function 

Comme extraite de http://www.di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html