Private m_szPath As String


Private Function UChartoChar(ByVal strVal As String) As String
    Dim strRes As String
    'hyperlabel(unicode pur) vers utf 8
    strRes = StrConv(strVal, vbFromUnicode)
    
    UChartoChar = strRes
End Function
Private Function ChartoUChar(ByVal strVal As String) As String
    Dim strRes As String
    'utf8 vers hyperlabel(unicode pur)
    strRes = StrConv(strVal, vbUnicode)
    
    ChartoUChar = strRes
End Function
Private Function PrintLine(ByRef FileSource As Scripting.TextStream, ByVal nRow As Integer) As Integer
    Dim nColumn As Integer
    Dim nRes As Integer
    Dim strName As String
    Dim strVal As String
    
    nColumn = 1
    While Cells(1, nColumn).Value <> ""
        strVal = ChartoUChar(Cells(nRow, nColumn).Value)
        If nColumn > 1 Then FileSource.Write ChartoUChar(";")
        FileSource.Write strVal
        'strName = ChartoUChar(Cells(1, nColumn).Value)
        'strVal = ChartoUChar(Cells(nRow, nColumn).Value)
        'nRes = HLBDLL_SetObjectValue(nDocID, strName, strVal)
        nColumn = nColumn + 1
    Wend
    FileSource.Write ChartoUChar(Chr(13))
    FileSource.Write ChartoUChar(Chr(10))
    
    PrintLine = nRes
End Function

Private Sub ButtonCancel_Click()
    Hide
End Sub
Private Function IsRowEmpty(ByVal nRow As Integer) As Integer
    Dim nRes As Integer
    Dim nColumn As Integer
    Dim strVal As String
    
    nRes = 0
    nColumn = 1
    While Cells(1, nColumn).Value <> "" And nRes <> 1
        If Cells(nRow, nColumn).Value <> "" Then
            nRes = 1
        End If
        nColumn = nColumn + 1
    Wend
    
    IsRowEmpty = nRes
End Function

Private Sub ButtonPrint_Click()
    Dim nRes As Integer
    Dim nRowID As Integer
    Dim fso As Scripting.FileSystemObject 'il faut ajouter dans les réferences Microsoft scripting runtime
    Dim FileSource As Scripting.TextStream
    Dim bContinu As Integer
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set FileSource = fso.CreateTextFile(m_szPath)
        
    nRes = PrintLine(FileSource, 1)
    
    nRowID = 2
    bContinu = IsRowEmpty(nRowID)
    While bContinu
        nRes = PrintLine(FileSource, nRowID)
        nRowID = nRowID + 1
        bContinu = IsRowEmpty(nRowID)
    Wend

    FileSource.Close
    Set fso = Nothing
    Set FileSource = Nothing

    MsgBox ("Les données ont été envoyées")

End Sub

Private Sub Quitter_Click()
    Hide
End Sub

Private Sub TextBoxCurrentDir_Change()
    m_szPath = TextBoxCurrentDir.Value
    SaveSetting "DataToScreen", "Setting", "Directory", TextBoxCurrentDir.Value
End Sub

Private Sub UserForm_Initialize()
    Dim bRes As Boolean
    Dim strCurSheet As String
    Dim strPrinter As String
    Dim nRow As Integer
    Dim nRes As Integer
    Dim nIndice, i As Integer
    Dim strPrinters As String * 1024
    Dim nPrinter As String
    
    strCurSheet = ActiveSheet.Name
    m_szPath = GetSetting("DataToScreen", "Setting", "Directory", "c:\")
    If m_szPath = "" Then m_szPath = "c:\"
    TextBoxCurrentDir.Value = m_szPath
    
    Exit Sub
    
CheckError:
    Exit Sub
    
End Sub