Option Explicit

Private Declare Sub gxds__setup Lib "GXDS" Alias "_gxds__setup@12" (ByVal version As String, ByVal name As String, ByVal gxdsVersion As String)
Private Declare Function gxds__need_more Lib "GXDS" Alias "_gxds__need_more@0" () As Boolean
Private Declare Sub gxds__get_name Lib "GXDS" Alias "_gxds__get_name@4" (ByVal name As String)
Private Declare Sub gxds__start_feed Lib "GXDS" Alias "_gxds__start_feed@4" (ByVal qty As Long)
Private Declare Sub gxds__feed Lib "GXDS" Alias "_gxds__feed@8" (ByVal value As String, ByVal row As Long)
Private Declare Sub gxds__finish_feed Lib "GXDS" Alias "_gxds__finish_feed@0" ()
Private Declare Sub gxds__finalize Lib "GXDS" Alias "_gxds__finalize@4" (ByVal send As Boolean)
Private Declare Function gxds__has_next_title Lib "GXDS" Alias "_gxds__has_next_title@0" () As Boolean

Private Declare Sub gxds__get_reply_title Lib "GXDS" Alias "_gxds__get_reply_title@4" (ByVal name As String)
Private Declare Function gxds__has_next_reply_title Lib "GXDS" Alias "_gxds__has_next_title@0" () As Boolean
Private Declare Sub gxds__close_session Lib "GXDS" Alias "_gxds__close_session@0" ()
Private Declare Function gxds__has_next_reply_item Lib "GXDS" Alias "_gxds__has_next_reply_item@0" () As Boolean
Private Declare Sub gxds__get_reply_item Lib "GXDS" Alias "_gxds__get_reply_item@4" (ByVal name As String)


Private Const GXDS_TOOLBAR As String = "GXDS: данные"
Private Const GXDS_REPLYBAR As String = "GXDS: приём"
Private Const GXDS_VERSION As String = "script 2.0"

Private Const SELECT_FACE  As Long = 39


Dim lastFilledRow     As Long
Dim interestedRowsQty As Long
Dim interestedRows()  As Long

Dim emptyRows()       As Long
Dim emptyRowsQty      As Long

Dim usedColumns()     As Long
Dim usedColumnsQty    As Long



Private Sub FillInterestedRows()
    Dim testedRow As Range
    Dim sel       As Long
    Dim real      As Long
    Dim idx       As Long
    Dim i         As Long
        
    interestedRowsQty = 0
    
    For Each testedRow In Selection.Rows
        idx = testedRow.Cells.row
        sel = testedRow.Cells.Count
        real = Rows(idx).EntireRow.Cells.Count
        
        If sel = real Then
            interestedRowsQty = interestedRowsQty + 1
        End If
    Next
    
    If interestedRowsQty = 0 Then
        interestedRowsQty = -1
    Else
        ReDim interestedRows(interestedRowsQty)
        
        i = 0
        
        For Each testedRow In Selection.Rows
             idx = testedRow.Cells.row
             sel = testedRow.Cells.Count
             real = Rows(idx).EntireRow.Cells.Count
         
             If sel = real Then
                interestedRows(i) = idx
                i = i + 1
            End If
        Next
    End If
End Sub



Private Function IsOneColumnSelected() As Boolean
    Dim testedColumn As Range
    Dim sel       As Long
    Dim real      As Long
    Dim idx       As Long
    Dim i         As Long
    
    If Selection.Areas.Count > 1 Then
        IsOneColumnSelected = False
        Exit Function
    End If
    
    If Selection.Columns.Count > 1 Then
        IsOneColumnSelected = False
        Exit Function
    End If
    
    If Selection.Cells.Count <> Selection.Columns(Selection.Column).EntireColumn.Cells.Count Then
        IsOneColumnSelected = False
        Exit Function
    End If
    
        
    IsOneColumnSelected = True
End Function



Private Sub FindLastRow()
On Error GoTo ErrorHandler
    lastFilledRow = Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).row
    Exit Sub
    
ErrorHandler:
    lastFilledRow = -1
End Sub


Private Sub ReselectProperly()
    Dim i As Long
    Dim newSelection As Range
    Dim tmp As Range
    
    If interestedRowsQty = -1 Then
        Set newSelection = Rows(1)
        For i = 2 To lastFilledRow
            Set newSelection = Union(newSelection, Rows(i))
        Next
    Else
        Set newSelection = Rows(interestedRows(0))
        For i = 1 To interestedRowsQty - 1
            Set tmp = Rows(interestedRows(i))
            Set newSelection = Union(newSelection, tmp)
        Next
    End If
    
    
    newSelection.Select
        
End Sub



Private Function FindGXDSToolBar() As CommandBar
    Dim currentBar As CommandBar
    
    
    For Each currentBar In Application.CommandBars
        If Not currentBar.BuiltIn And currentBar.name = GXDS_TOOLBAR Then
            Set FindGXDSToolBar = currentBar
            Exit Function
        End If
    Next

    Set FindGXDSToolBar = Nothing
End Function


Private Function FindGXDSReplyBar() As CommandBar
    Dim currentBar As CommandBar
    
    
    For Each currentBar In Application.CommandBars
        If Not currentBar.BuiltIn And currentBar.name = GXDS_REPLYBAR Then
            Set FindGXDSReplyBar = currentBar
            Exit Function
        End If
    Next

    Set FindGXDSReplyBar = Nothing
End Function


Private Function CreateGXDSToolBar() As CommandBar
    Dim readyBar As CommandBar

    Set readyBar = Application.CommandBars.Add(GXDS_TOOLBAR, , False, True)

    With readyBar
        With .Controls.Add(Type:=msoControlEdit)
           .BeginGroup = True
           .Enabled = False
           .Width = 300
           
           
           
           
        End With
        With .Controls.Add(Type:=msoControlButton)
            .BeginGroup = False
            .OnAction = "DataButtonHandler"
        End With
        
        
    End With

    readyBar.Protection = msoBarNoHorizontalDock + msoBarNoVerticalDock
    Set CreateGXDSToolBar = readyBar
End Function



Private Function CreateGXDSReplyBar() As CommandBar
    Dim readyBar As CommandBar

    Set readyBar = Application.CommandBars.Add(GXDS_REPLYBAR, , False, True)

    With readyBar
        With .Controls.Add(Type:=msoControlEdit)
           .BeginGroup = True
           .Enabled = False
           .Width = 300
           
           
           
           
        End With
        With .Controls.Add(Type:=msoControlButton)
            .BeginGroup = False
            .OnAction = "ReplyButtonHandler"
        End With
        
        
    End With

    readyBar.Protection = msoBarNoHorizontalDock + msoBarNoVerticalDock
    Set CreateGXDSReplyBar = readyBar
End Function


Private Sub SetToolBarNames(edit As String, editToolTip As String, buttonToolTip As String, buttonFace As Long)
    Dim Bar As CommandBar
    Dim control As CommandBarControl
    
    
    
    Set Bar = FindGXDSToolBar
    If Bar Is Nothing Then
        Set Bar = CreateGXDSToolBar
    End If
    
    For Each control In Bar.Controls
        If control.Type = msoControlButton Then
            control.Caption = buttonToolTip
            control.FaceId = buttonFace
        End If
        
        If control.Type = msoControlEdit Then
            control.Enabled = True
            control.Text = edit
            control.Enabled = False
                                     
            control.Caption = editToolTip
        End If
        
    Next
    
End Sub

Private Sub SetReplyBarNames(edit As String, editToolTip As String, buttonToolTip As String, buttonFace As Long)
    Dim Bar As CommandBar
    Dim control As CommandBarControl
    
    
    
    Set Bar = FindGXDSReplyBar
    If Bar Is Nothing Then
        Set Bar = CreateGXDSReplyBar
    End If
    
    For Each control In Bar.Controls
        If control.Type = msoControlButton Then
            control.Caption = buttonToolTip
            control.FaceId = buttonFace
        End If
        
        If control.Type = msoControlEdit Then
            control.Enabled = True
            control.Text = edit
            control.Enabled = False
                                     
            control.Caption = editToolTip
        End If
        
    Next
    
End Sub




Private Sub HideToolbar()
    Dim Bar As CommandBar
    
    Set Bar = FindGXDSToolBar
    If Bar Is Nothing Then
        Set Bar = CreateGXDSToolBar
    End If

    Bar.Visible = False
End Sub


Private Sub ShowToolbar()
    Dim Bar As CommandBar
    
    Set Bar = FindGXDSToolBar
    If Bar Is Nothing Then
        Set Bar = CreateGXDSToolBar
    End If

    Bar.Visible = True
End Sub



Private Sub HideReplybar()
    Dim Bar As CommandBar
    
    Set Bar = FindGXDSReplyBar
    If Bar Is Nothing Then
        Set Bar = CreateGXDSReplyBar
    End If

    Bar.Visible = False
End Sub


Private Sub ShowReplybar()
    Dim Bar As CommandBar
    
    Set Bar = FindGXDSReplyBar
    If Bar Is Nothing Then
        Set Bar = CreateGXDSReplyBar
    End If

    Bar.Visible = True
End Sub


Private Function IsRowEmpty(index As Long) As Boolean
    Dim currentCell As Range
    
    For Each currentCell In Rows(index).EntireRow.Cells
        If Not IsNull(currentCell.value) And Not IsEmpty(currentCell.value) Then
            IsRowEmpty = False
            Exit Function
        End If
    Next
    
    IsRowEmpty = True
End Function



Private Sub RegisterEmptyRow(index As Long)
    emptyRowsQty = emptyRowsQty + 1
    ReDim Preserve emptyRows(emptyRowsQty) As Long
    
    emptyRows(emptyRowsQty - 1) = index
End Sub


Private Sub RegisterEmptyRows()
    Dim i As Long
    
    If interestedRowsQty = -1 Then
        For i = 1 To lastFilledRow
            If IsRowEmpty(i) Then
                RegisterEmptyRow (i)
            End If
        Next
    Else
        For i = 0 To interestedRowsQty - 1
            If IsRowEmpty(interestedRows(i)) Then
                RegisterEmptyRow (interestedRows(i))
            End If
        Next
    End If
End Sub


Private Function isArrayContains(arr() As Long, qty As Long, idx As Long) As Boolean
    Dim i As Long
    
    For i = 0 To qty - 1
        If arr(i) = idx Then
            isArrayContains = True
            Exit Function
        End If
    Next
    
    isArrayContains = False
End Function


Private Sub RegisterUsed(index As Long)
    If Not isArrayContains(usedColumns, usedColumnsQty, index) Then
        usedColumns(usedColumnsQty) = index
        usedColumnsQty = usedColumnsQty + 1
    End If
End Sub




Private Sub ShowFinalSelection()
    Dim i As Long
    Dim j As Long
    Dim q As Long
    Dim newSelection As Range
    Dim inited As Boolean
    
    inited = False
        
    If interestedRowsQty = -1 Then
        For i = 1 To lastFilledRow
            If Not isArrayContains(emptyRows, emptyRowsQty, i) Then
                For j = 0 To usedColumnsQty - 1
                    If inited Then
                        Set newSelection = Union(newSelection, Cells(i, usedColumns(j)))
                    Else
                        Set newSelection = Cells(i, usedColumns(j))
                        inited = True
                    End If
                Next
            End If
        Next
    Else
        For q = 0 To interestedRowsQty - 1
            i = interestedRows(q)
            If Not isArrayContains(emptyRows, emptyRowsQty, i) Then
                For j = 0 To usedColumnsQty - 1
                    If inited Then
                        Set newSelection = Union(newSelection, Cells(i, usedColumns(j)))
                    Else
                        Set newSelection = Cells(i, usedColumns(j))
                        inited = True
                    End If
                Next
            End If
        Next
    End If
    
    If inited Then
        newSelection.Select
    End If
    
End Sub


Private Function CheckNotEmpty() As Boolean
    Dim i As Long
    Dim q As Long
    
    If interestedRowsQty = -1 Then
        For i = 1 To lastFilledRow
            If Not isArrayContains(emptyRows, emptyRowsQty, i) Then
                CheckNotEmpty = True
                Exit Function
            End If
        Next
    Else
        For q = 0 To interestedRowsQty - 1
            i = interestedRows(q)
            If Not isArrayContains(emptyRows, emptyRowsQty, i) Then
                CheckNotEmpty = True
                Exit Function
            End If
        Next
    End If
    
    CheckNotEmpty = False
End Function
        


Public Sub gxds_start()
    Dim readyBar As CommandBar
    Dim replyBar As CommandBar
        
    lastFilledRow = 0
    interestedRowsQty = 0
    emptyRowsQty = 0
        
    usedColumnsQty = 0
    ReDim usedColumns(Cells(1).EntireRow.Cells.Count) As Long
        
    
    ReDim interestedRows(0) As Long
    ReDim emptyRows(0) As Long
        
    
    FillInterestedRows
    FindLastRow
        
    If lastFilledRow = -1 Then
        MsgBox ("Документ не содержит данных.")
        Exit Sub
    End If
        
    ReselectProperly
    RegisterEmptyRows
    
    If Not CheckNotEmpty Then
        MsgBox ("Документ не содержит данных.")
        Exit Sub
    End If
    

    Set readyBar = FindGXDSToolBar
    If readyBar Is Nothing Then
        Set readyBar = CreateGXDSToolBar
    Else
        readyBar.Visible = False
    End If
    
    
    Set replyBar = FindGXDSReplyBar
    If replyBar Is Nothing Then
        Set replyBar = CreateGXDSReplyBar
    End If
    replyBar.Visible = False

   
    gxds__setup Application.name & " " & Application.version, ActiveWorkbook.name, GXDS_VERSION
    If gxds__need_more Then
        StartFeed
    Else
        readyBar.Delete
    End If

End Sub


Private Sub StartFeed()
    Dim res As String * 255
    
    gxds__get_name (res)
    SetToolBarNames res, "Выделите колонку, содержащую '" & res & "' и нажмите кнопку", "Далее", SELECT_FACE
    ShowToolbar
End Sub


Public Sub DataButtonHandler()
    Dim theColumn As Long
    Dim i As Long
    Dim j As Long
    Dim q As Long
    Dim res As Integer
    Dim readyBar As CommandBar
    Dim release As Boolean
    
    
    
    Dim submittedQty As Long
    
    If Not IsOneColumnSelected Then
        MsgBox "Вы должны указать ровно одну колонку!"
        Exit Sub
    End If
    
    HideToolbar
    
    release = True
    
    
    theColumn = Selection.Column
    
    RegisterUsed theColumn
    
    
    If interestedRowsQty = -1 Then
        submittedQty = lastFilledRow - emptyRowsQty
    Else
        submittedQty = interestedRowsQty - emptyRowsQty
    End If
    
    
    gxds__start_feed submittedQty
        
    If interestedRowsQty = -1 Then
        For i = 1 To lastFilledRow
            If Not isArrayContains(emptyRows, emptyRowsQty, i) Then
                gxds__feed Cells(i, theColumn).value, i
            End If
        Next
    Else
        For q = 0 To interestedRowsQty - 1
            i = interestedRows(q)
            If Not isArrayContains(emptyRows, emptyRowsQty, i) Then
                gxds__feed Cells(i, theColumn).value, i
            End If
        Next
    End If
        
    
    gxds__finish_feed
    
    If gxds__need_more Then
        StartFeed
    Else
        ShowFinalSelection
        res = MsgBox(prompt:="Данные выделены. Посылать?", Buttons:=vbYesNo)
        If res = vbYes Then
            gxds__finalize (res = vbYes)
        End If
        
        Set readyBar = FindGXDSToolBar
        If Not readyBar Is Nothing Then
            readyBar.Delete
        End If
        
        If res = vbYes Then
            If gxds__has_next_title Then
                release = False
                StartGet
            End If
        End If
        
        If release Then
            gxds__close_session
        End If
    End If
End Sub


Private Sub StartGet()
    Dim res As String * 255
    
    gxds__get_reply_title (res)
    SetReplyBarNames res, "Выделите колонку, в которую загрузится '" & res & "' и нажмите кнопку", "Далее", SELECT_FACE
    ShowReplybar
End Sub


Public Sub ReplyButtonHandler()
    Dim theColumn As Long
    Dim i As Long
    Dim j As Long
    Dim q As Long
    Dim res As Integer
    Dim readyBar As CommandBar
    Dim release As Boolean
    Dim value As String * 255
    
    
    Dim submittedQty As Long
    
    If Not IsOneColumnSelected Then
        MsgBox "Вы должны указать ровно одну колонку!"
        Exit Sub
    End If
    
    HideReplybar
    
    
    theColumn = Selection.Column
    
       
    If interestedRowsQty = -1 Then
        submittedQty = lastFilledRow - emptyRowsQty
    Else
        submittedQty = interestedRowsQty - emptyRowsQty
    End If
    
        
    If interestedRowsQty = -1 Then
        For i = 1 To lastFilledRow
            If Not isArrayContains(emptyRows, emptyRowsQty, i) Then
                gxds__get_reply_item (value)
                
                Cells(i, theColumn).value = value
            End If
        Next
    Else
        For q = 0 To interestedRowsQty - 1
            i = interestedRows(q)
            If Not isArrayContains(emptyRows, emptyRowsQty, i) Then
                gxds__get_reply_item (value)
                
                Cells(i, theColumn).value = value
            End If
        Next
    End If
    
    If gxds__has_next_title Then
         StartGet
    Else
        gxds__close_session
    End If
End Sub