VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Query_Result 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Query result"
   ClientHeight    =   6720
   ClientLeft      =   135
   ClientTop       =   390
   ClientWidth     =   9435
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6720
   ScaleWidth      =   9435
   ShowInTaskbar   =   0   'False
   Begin MSFlexGridLib.MSFlexGrid Grid_Result 
      Height          =   1875
      Left            =   120
      TabIndex        =   12
      Top             =   1020
      Width           =   8715
      _ExtentX        =   15372
      _ExtentY        =   3307
      _Version        =   393216
      FixedRows       =   0
      FixedCols       =   0
      HighLight       =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin VB.PictureBox pic_Excel 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      DragIcon        =   "Q_DETAIL.frx":0000
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   480
      Left            =   6600
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   60
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.PictureBox pic_Pic2 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C0C0C0&
      Height          =   2412
      Left            =   8280
      ScaleHeight     =   2385
      ScaleWidth      =   630
      TabIndex        =   8
      Top             =   3960
      Width           =   665
      Begin VB.PictureBox pic_print 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DrawStyle       =   5  'Transparent
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   60
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   9
         Top             =   60
         Visible         =   0   'False
         Width           =   480
      End
   End
   Begin VB.ListBox lst_Detail 
      Height          =   645
      ItemData        =   "Q_DETAIL.frx":030A
      Left            =   240
      List            =   "Q_DETAIL.frx":030C
      MultiSelect     =   1  'Simple
      TabIndex        =   6
      Top             =   3180
      Width           =   3012
   End
   Begin VB.CommandButton cmd_Detail 
      Caption         =   "Show details"
      Enabled         =   0   'False
      Height          =   372
      Left            =   3360
      TabIndex        =   5
      Top             =   3420
      Width           =   1392
   End
   Begin VB.PictureBox pic_pic 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   665
      Left            =   0
      ScaleHeight     =   630
      ScaleWidth      =   7170
      TabIndex        =   2
      Top             =   0
      Width           =   7200
      Begin VB.PictureBox pic_PrintResult 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DrawStyle       =   5  'Transparent
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   60
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   10
         Top             =   60
         Width           =   480
      End
      Begin VB.PictureBox pic_Refresh 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "Q_DETAIL.frx":030E
         DrawStyle       =   5  'Transparent
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   600
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   4
         Top             =   60
         Width           =   480
      End
      Begin VB.PictureBox pic_quit 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "Q_DETAIL.frx":0618
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   1800
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   3
         TabStop         =   0   'False
         Top             =   60
         Width           =   480
      End
   End
   Begin VB.PictureBox pic_next25 
      AutoSize        =   -1  'True
      Height          =   480
      Left            =   8880
      ScaleHeight     =   420
      ScaleWidth      =   420
      TabIndex        =   0
      Top             =   2340
      Width           =   480
   End
   Begin MSFlexGridLib.MSFlexGrid Grid_Detail 
      Height          =   2415
      Left            =   120
      TabIndex        =   13
      Top             =   3960
      Width           =   8175
      _ExtentX        =   14420
      _ExtentY        =   4260
      _Version        =   393216
      FixedRows       =   0
      FixedCols       =   0
      HighLight       =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin VB.Label lbl_Detail 
      Caption         =   "Details :"
      Height          =   225
      Left            =   240
      TabIndex        =   7
      Top             =   2940
      Width           =   3015
   End
   Begin VB.Label lbl_result 
      Caption         =   "Result :"
      Height          =   225
      Left            =   120
      TabIndex        =   1
      Top             =   780
      Width           =   2265
   End
End
Attribute VB_Name = "Query_Result"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mo_Fetch As Fetch

Dim ml_Hstmt As Long
Dim mi_Status As Integer
Dim ml_TotCount As Long
Dim ml_ResultIndex As Long
Dim ml_DetailIndex As Long
Dim ml_RowClick As String
Dim ml_ExcelStat As Long

Private Sub ExcelExportTable()
Dim li_Status As Integer
Dim ls_Req As String
Dim i As Integer
Dim li_PosDebut As Integer
Dim li_Length As Integer
Dim ls_ReqClaim As String

Select Case UCase(gut_Param.Str1)
Case "BASE_ITEM"
    ls_Req = "CREATE TABLE #ExcelExport (" _
            & " BI_SAP_code " & "CHAR(20) " & " NULL " & ", " _
            & " BI_desc " & "VARCHAR(150) " & " NULL "
Case "CLAIM"
    ls_Req = "CREATE TABLE #ExcelExport (" _
            & " CLA_code " & "CHAR(10) " & " NULL "
Case "SA_HISTORIC"
    ls_Req = "CREATE TABLE #ExcelExport (" _
            & "sa_billing_document_number  " & "CHAR(10) " & " NULL "
End Select
For i = 1 To UBound(gi_CritExcel)
    ls_Req = ls_Req _
        & ", " & gut_Excel(gi_CritExcel(i)).BaseName & " " _
        & gut_Excel(gi_CritExcel(i)).DataType & " NULL "
Next
ls_Req = ls_Req & ")"
If SQLSubmitServer(gl_Environment, gl_Database, ml_ExcelStat, ls_Req) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
    li_Status = SQLFreeStatement(ml_ExcelStat, SQL_DROP)
    Exit Sub
End If

Select Case UCase(gut_Param.Str1)
Case "BASE_ITEM"
    ls_Req = "INSERT INTO #ExcelExport (BI_SAP_code, BI_desc) " _
            & gut_Param.Str21
Case "CLAIM"
    li_PosDebut = InStr(1, gut_Param.Str21, ", Claim.CLA_description", 1)
    li_Length = Len(", Claim.CLA_description")
    ls_ReqClaim = Mid(gut_Param.Str21, 1, li_PosDebut - 1)
    ls_ReqClaim = ls_ReqClaim & Mid(gut_Param.Str21, li_PosDebut + li_Length)
    ls_Req = "INSERT INTO #ExcelExport (CLA_code) " _
           & ls_ReqClaim
Case "SA_HISTORIC"
    ls_Req = "INSERT INTO #ExcelExport (sa_billing_document_number) " _
            & gut_Param.Str21
End Select

If SQLSubmitServer(gl_Environment, gl_Database, ml_ExcelStat, ls_Req) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
    li_Status = SQLFreeStatement(ml_ExcelStat, SQL_DROP)
    Exit Sub
End If

For i = 1 To UBound(gi_CritExcel)
    ls_Req = "UPDATE #ExcelExport " _
        & gut_Excel(gi_CritExcel(i)).ReqUpdate
    If SQLSubmitServer(gl_Environment, gl_Database, ml_ExcelStat, ls_Req) Then
        li_Status = SQL_SUCCESS
    Else
        li_Status = SQL_ERROR
        li_Status = SQLFreeStatement(ml_ExcelStat, SQL_DROP)
        Exit Sub
    End If
Next

End Sub

Private Sub cmd_Detail_Click()

Dim li_Count As Integer
Dim ls_Param As String

MouseOff
GridClear Grid_Detail
ml_DetailIndex = 0
For li_Count = 0 To lst_Detail.ListCount - 1
    If lst_Detail.Selected(li_Count) Then
        Grid_Result.Row = ml_RowClick
        Grid_Result.Col = 0
        ls_Param = gut_Detail(lst_Detail.ItemData(li_Count)).Detail
        FillDetailPart ls_Param, lst_Detail.List(li_Count), Grid_Result.Text
        pic_print.Visible = OK
    End If
Next li_Count
MouseOn

End Sub
Private Sub Form_Load()

MouseOff

If gl_CodePage <> 1252 And gl_CodePage <> 0 Then ChangeCharset Me

pic_PrintResult.Picture = LoadResPicture(RES_PRINT, 1)
pic_Refresh.Picture = LoadResPicture(RES_REFRESH, 1)
pic_quit.Picture = LoadResPicture(RES_QUIT, 1)
pic_next25.Picture = LoadResPicture(RES_DOWN, 1)
pic_print.Picture = LoadResPicture(RES_PRINT, 1)
pic_Excel.Picture = LoadResPicture(RES_EXCEL, 1)
Caption = Query.lbl_Title
lbl_Detail = Query.lbl_Detail
cmd_Detail.Caption = Query.Lbl_start
Grid_Detail.ColWidth(0) = 2000
Grid_Detail.ColWidth(1) = 20000
Grid_Detail.ColAlignment(1) = flexAlignLeftCenter
FillResults
GetDetails
ml_DetailIndex = 0
MouseOn

End Sub
Private Function FillMore25() As Boolean

Dim ls_Field1 As String
Dim ls_Field2 As String
Dim li_Count As Integer
Dim i As Integer

On Error GoTo suite
FillMore25 = KO
li_Count = mo_Fetch.FillMore
For i = 1 To li_Count
    Grid_Result.Rows = ml_ResultIndex + 1
    Grid_Result.Row = ml_ResultIndex
    
    Grid_Result.Col = 0
    Grid_Result.Text = mo_Fetch.GetData(i, 1)
    Grid_Result.Col = 1
    Grid_Result.Text = mo_Fetch.GetData(i, 2)
    lbl_result = Query.lbl_result & " " & Grid_Result.Rows & "... / " & ml_TotCount & " " & Query.lbl_Result2
    DoEvents
    ml_ResultIndex = ml_ResultIndex + 1
Next

If li_Count = mo_Fetch.MaxRowCount And ml_ResultIndex <> ml_TotCount Then
    FillMore25 = OK
End If

Exit Function

suite:
FillMore25 = KO
StdError
End Function
Private Function FillAll() As Boolean

Dim ls_Field1 As String
Dim ls_Field2 As String
Dim li_Count As Integer

On Error GoTo suite

pic_next25.Visible = False

Do While FillMore25 = OK
Loop

If ml_ResultIndex = 0 Then
    lbl_result = Query.lbl_result & " " & "0 / " & ml_TotCount & " " & Query.lbl_Result2
Else
    lbl_result = Query.lbl_result & " " & Grid_Result.Rows & " / " & ml_TotCount & " " & Query.lbl_Result2
End If
DoEvents
Exit Function

suite:
StdError
End Function
Private Sub GetDetails()
' Fill the details list
Dim i As Integer

lst_Detail.Clear
For i = 0 To UBound(gut_Detail)
    lst_Detail.AddItem gut_Detail(i).DetailTrans
    lst_Detail.ItemData(lst_Detail.ListCount - 1) = i
Next i

End Sub
Private Sub Form_Unload(Cancel As Integer)

Set mo_Fetch = Nothing

End Sub



Private Sub Grid_Result_Click()

MouseOff
ml_RowClick = 0
GridClear Grid_Detail
pic_print.Visible = KO
If ml_ResultIndex > 0 Then
    Grid_Result.HighLight = flexHighlightAlways
'    Grid_Result.SelStartCol = 0
'    Grid_Result.SelEndCol = 1
End If
'Grid_Result.Col = 0
ml_RowClick = Grid_Result.Row
'Grid_Result.Row = 0
'Grid_Result.Col = 0
lst_Detail.SetFocus
MouseOn

End Sub



Private Sub lst_Detail_Click()

MouseOff
If LstIsItemSel(lst_Detail) And Grid_Result.HighLight = flexHighlightAlways Then
    cmd_Detail.Enabled = OK
Else
    cmd_Detail.Enabled = KO
End If
MouseOn

End Sub

Private Sub pic_Excel_Click()
Dim ExcelApp As Object
Dim ExcelWorkBook As Object
Dim ExcelSheet As Object
Dim li_Col As Long
Dim li_Row As Long
Dim ls_ReqExcel As String
Dim li_Status As Integer

On Error GoTo suite

MouseOff
If UCase(gut_Param.Str1) = "BASE_ITEM" Or UCase(gut_Param.Str1) = "CLAIM" Then
    Query_Excel.show 1
Else
    ReDim gi_CritExcel(0)
End If

If UBound(gi_CritExcel) = 1 Then
    If gi_CritExcel(1) = -1 Then
        ReDim gi_CritExcel(0)
        MouseOn
        Exit Sub
    End If
End If
Set ExcelApp = CreateObject("Excel.Application")
Set ExcelWorkBook = ExcelApp.Workbooks.Add
Set ExcelSheet = ExcelWorkBook.WorkSheets(1)
ExcelExportTable
ExcelApp.Application.Visible = OK
ExcelSheet.Application.Visible = OK

' Column Header
li_Row = 1
Select Case UCase(gut_Param.Str1)
Case "BASE_ITEM"
    With ExcelSheet
        .cells(1, 1).value = "CLS item n°"
        .cells(1, 2).value = "CLS description"
    End With
    For li_Col = 1 To UBound(gi_CritExcel)
        With ExcelSheet
            .cells(li_Row, li_Col + 2).value = ConvertCodePageFromAnsi(gut_Excel(gi_CritExcel(li_Col)).Criteria, gl_CodePage)
        End With
    Next
Case "CLAIM"
    With ExcelSheet
        .cells(1, 1).value = "Claim code"
'        .cells(1, 2).Value = "Claim description"
    End With
    For li_Col = 1 To UBound(gi_CritExcel)
        With ExcelSheet
'            .cells(li_Row, li_Col + 2).Value = gut_Excel(gi_CritExcel(li_Col)).Criteria
            .cells(li_Row, li_Col + 1).value = ConvertCodePageFromAnsi(gut_Excel(gi_CritExcel(li_Col)).Criteria, gl_CodePage)
        End With
    Next
Case "SA_HISTORIC"
    With ExcelSheet
        .cells(1, 1).value = "Billing document n°"
    End With
    For li_Col = 1 To UBound(gi_CritExcel)
        With ExcelSheet
            .cells(li_Row, li_Col + 1).value = ConvertCodePageFromAnsi(gut_Excel(gi_CritExcel(li_Col)).Criteria, gl_CodePage)
        End With
    Next
End Select
  
' Row and Column values
Select Case UCase(gut_Param.Str1)
Case "BASE_ITEM"
    ls_ReqExcel = "SELECT * FROM #ExcelExport ORDER BY BI_SAP_code"
Case "CLAIM"
    ls_ReqExcel = "SELECT * FROM #ExcelExport ORDER BY CLA_code"
Case "SA_HISTORIC"
    ls_ReqExcel = "SELECT * FROM #ExcelExport ORDER BY sa_billing_document_number"
End Select
If SQLSubmitServer(gl_Environment, gl_Database, ml_ExcelStat, ls_ReqExcel) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
End If
Do While li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO
    li_Status = SQLFetch(ml_ExcelStat)
    li_Row = li_Row + 1
    If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
        For li_Col = 1 To UBound(gi_CritExcel) + 2
        With ExcelSheet
            .cells(li_Row, li_Col).value = ConvertCodePageFromAnsi("'" & ODBCData(ml_ExcelStat, li_Col), gl_CodePage)
        End With
        Next li_Col
    End If
Loop

ls_ReqExcel = "DROP TABLE #ExcelExport "
If SQLSubmitServer(gl_Environment, gl_Database, ml_ExcelStat, ls_ReqExcel) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
End If
li_Status = SQLFreeStatement(ml_ExcelStat, SQL_DROP)
Me.Visible = OK
SendMessage 108, "Press ALT+TAB to switch to the Excel application and then save the Excel file. Then back to the Product Database and click OK to close the Excel application.", gut_LangLogin.Code
ExcelApp.Quit
Set ExcelSheet = Nothing
Set ExcelWorkBook = Nothing
Set ExcelApp = Nothing
MouseOn
Exit Sub

suite:
Set ExcelSheet = Nothing
Set ExcelWorkBook = Nothing
Set ExcelApp = Nothing
li_Status = SQLFreeStatement(ml_ExcelStat, SQL_DROP)
If Err.Number = 429 Or Err.Number = 432 Then
    SendMessage 126, "Excel application can not be load", gut_LangLogin.Code
    MouseOn
ElseIf Err.Number = -2147418106 Or Err.Number = -2147417852 Then
    MouseOn
ElseIf Err.Number = 424 Then
    SendMessage 127, "Loosing communication with Excel, export aborted", gut_LangLogin.Code
    MouseOn
Else
    StdError
    MouseOn
End If
End Sub
Private Sub pic_next25_Click()

MouseOff
pic_next25.Visible = FillMore25
lbl_result = Query.lbl_result & " " & Grid_Result.Rows & " / " & ml_TotCount & " " & Query.lbl_Result2
MouseOn

End Sub

Private Sub pic_print_Click()

If Printers.Count = 0 Then
    SendMessage 135, "No printer is installed on your computer. Please, contact your system administrator.", gut_LangLogin.Code
    Exit Sub
End If

MouseOff
Select Case UCase(gut_Param.Str1)
    Case "CLAIM"
        QryPrintGrid 1, 10, Caption, "CLAIM DETAILS", Grid_Detail, Array(20, 80)
    Case "BASE_ITEM"
        QryPrintGrid 1, 20, Caption, "PRODUCT DETAILS", Grid_Detail, Array(40, 60)
    Case "SA_HISTORIC"
        QryPrintGrid 1, 20, Caption, "BILL DETAILS", Grid_Detail, Array(30, 70)
End Select
MouseOn

End Sub
Private Sub pic_PrintResult_Click()
Dim ls_Ligne As String
Dim li_Count As Integer
Dim ls_Title As String

    If Printers.Count = 0 Then
        SendMessage 135, "No printer is installed on your computer. Please, contact your system administrator.", gut_LangLogin.Code
        Exit Sub
    End If
    
    MouseOff
    
    ls_Title = InputMessage(136, "Type your query title, please.", Query_Result.Caption)
    
    'Print the query
    PrintQry 1, Query.pic_bureau, ls_Title
    
    'Print the result
    If pic_next25.Visible Then
    ' The list is not fully loaded
        FillAll
        pic_next25.Visible = KO
    End If
    Select Case UCase(gut_Param.Str1)
        Case "CLAIM"
            QryPrintGrid 2, 10, Caption & " - " & ls_Title, CStr(ml_TotCount) & " Claim(s)", Grid_Result, Array(15, 130)
        Case "BASE_ITEM"
            QryPrintGrid 1, 2, ls_Title, CStr(ml_TotCount) & " Item(s)", Grid_Result, Array(30, 70)
        Case "SA_HISTORIC"
            QryPrintGrid 1, 20, Caption & " - " & ls_Title, CStr(ml_TotCount) & " Sale(s) analysis", Grid_Result, Array(20, 80)
    End Select
    
    MouseOn

End Sub
Private Sub pic_quit_Click()

MouseOff
Unload Me

End Sub
Private Sub PrintDetail(ls_Col0 As String, ls_Col1 As String)
' Print grid col0 and col1 content

On Error GoTo ErrTM99027

Grid_Detail.Row = ml_DetailIndex - 1
Grid_Detail.Col = 0
Grid_Detail.Text = ls_Col0
Grid_Detail.Col = 1
Grid_Detail.Text = ls_Col1
ml_DetailIndex = ml_DetailIndex + 1
Grid_Detail.Rows = ml_DetailIndex
Exit Sub

ErrTM99027:
SQLFreeStatement ml_Hstmt, SQL_DROP
StdError
End Sub
Private Sub FillDetailPart(a_DetailPart As String, a_DetailTrans As String, a_SAPCode As String)
' Get all the caracteristics of a product
' for the a_DetailPart
Dim ls_Line As String
Dim ls_Param As String
Dim li_SubCount As Integer

On Error GoTo ErrTM99027a

ls_Line = "======================================"
Select Case UCase(gut_Param.Str1)
    Case "CLAIM"
        Grid_Detail.ColWidth(0) = 2000
        Grid_Detail.ColWidth(1) = 20000
    Case "BASE_ITEM"
        Grid_Detail.ColWidth(0) = 3000
        Grid_Detail.ColWidth(1) = 10000
    Case "SA_HISTORIC"
        Grid_Detail.ColWidth(0) = 3000
        Grid_Detail.ColWidth(1) = 11000
    Case "TEST"
        Grid_Detail.ColWidth(0) = 3000
        Grid_Detail.ColWidth(1) = 10000
End Select

If ml_DetailIndex = 0 Then
    Grid_Detail.Row = 0
Else
    Grid_Detail.Row = ml_DetailIndex - 1
End If
Grid_Detail.Col = 0
Grid_Detail.Text = ls_Line
Grid_Detail.Col = 1
Grid_Detail.Text = ls_Line
ml_DetailIndex = ml_DetailIndex + 1
Grid_Detail.Rows = ml_DetailIndex

Grid_Detail.Row = ml_DetailIndex - 1
Grid_Detail.Col = 0
Grid_Detail.Text = a_DetailTrans
Grid_Detail.Col = 1
Grid_Result.Row = ml_RowClick
Grid_Result.Col = 1
If UCase(gut_Param.Str1) = "SA_HISTORIC" Then Grid_Result.Col = 0
Grid_Detail.Text = Grid_Result.Text
ml_DetailIndex = ml_DetailIndex + 1
Grid_Detail.Rows = ml_DetailIndex

Grid_Detail.Row = ml_DetailIndex - 1
Grid_Detail.Col = 0
Grid_Detail.Text = ls_Line
Grid_Detail.Col = 1
Grid_Detail.Text = ls_Line
ml_DetailIndex = ml_DetailIndex + 1
Grid_Detail.Rows = ml_DetailIndex

For li_SubCount = 0 To UBound(gut_SubDetail)
    If gut_SubDetail(li_SubCount).Detail = a_DetailPart Then
        ls_Param = gut_SubDetail(li_SubCount).SubDetail
        FillDetailSubPart a_DetailPart, ls_Param, a_SAPCode
    End If
Next li_SubCount
Exit Sub

ErrTM99027a:
SQLFreeStatement ml_Hstmt, SQL_DROP
StdError
End Sub
Private Sub FillDetailSubPart(a_DetailPart As String, a_DetailSubPart As String, a_SAPCode As String)
' Get all the caracteristics of a product
' for the a_DetailPart
Dim ls_Req As String
Dim ls_Query As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim li_TransCount As Integer
Dim li_TransBegin As Integer
Dim li_Count As Integer
Dim ls_Col0 As String, ls_Col1 As String

On Error GoTo ErrTM99027b
'Modif TM le 17/09/99 diriger les catégories C003,4,5,6,7
'vers Base_Item_1_BI_part... ou Base_Item_2_BI_part
'au lieu de Base_Item_3_BI..,Base_Item_4... etc...
' et destruction des proc stock Base_Item_3_BI..,Base_Item_4... etc...
li_TransBegin = -1
For li_TransCount = 0 To UBound(gut_Field)
    If gut_Field(li_TransCount).Detail = a_DetailPart And _
      gut_Field(li_TransCount).SubDetail = a_DetailSubPart Then
        li_TransBegin = li_TransCount
        Exit For
    End If
Next li_TransCount
ls_Query = gut_Param.Str8
Select Case gut_Param.Str1
Case "Base_Item", "Claim"
    ls_Query = ls_Query & CInt(Mid(Query.cbo_CategoryCode.List(Query.cbo_category.ListIndex), 2, 3)) & "_"
Case "sa_historic"
    ls_Query = ls_Query & "1_"
End Select
If gi_QuerySecurityLevel = 0 Then
    ls_Req = "EXEC " & ls_Query _
        & a_DetailPart & a_DetailSubPart & "_sel '" _
        & a_SAPCode & "', '" & gut_LangLogin.Code & "'"
Else
    ls_Req = "EXEC " & ls_Query _
        & a_DetailPart & a_DetailSubPart & "_sel" _
        & gi_QuerySecurityLevel & " '" _
        & a_SAPCode & "', '" & gut_LangLogin.Code & "'"
End If
If SQLSubmitServer(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
End If
Do While li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
        For li_Count = 2 To ODBCData(ll_Statement, 1) + 1
            If li_TransBegin = -1 Then
'           No translation for details
                ls_Col0 = ODBCData(ll_Statement, li_Count)
            Else
                If gut_Field(li_TransCount).Detail = a_DetailPart Then
'               Translation for the right detail part
                    If gut_Field(li_TransCount).SubDetail <> a_DetailSubPart Then
'                   Come back to the first translation for the right detail subpart
                        li_TransCount = li_TransBegin
                    End If
                Else
'               Come back to the first translation for the right detail subpart
                    li_TransCount = li_TransBegin
                End If
                ls_Col1 = ODBCData(ll_Statement, li_Count)
                PrintDetail gut_Field(li_TransCount).trans, ls_Col1
            End If
            If li_TransCount < UBound(gut_Field) Then
                li_TransCount = li_TransCount + 1
            Else
                li_TransCount = li_TransBegin
            End If
        Next li_Count
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Sub

ErrTM99027b:
SQLFreeStatement ml_Hstmt, SQL_DROP
StdError
End Sub
Private Sub FillResults()

On Error GoTo suite

lbl_result = Query.lbl_result & "???"
ml_ResultIndex = 0
GridClear Grid_Result
GridClear Grid_Detail
Select Case UCase(gut_Param.Str1)
    Case "CLAIM"
        Grid_Result.ColWidth(0) = 1000
        Grid_Result.ColWidth(1) = 8000
    Case "BASE_ITEM"
        Grid_Result.ColWidth(0) = 2000
        Grid_Result.ColWidth(1) = 6000
    Case "SA_HISTORIC"
        Grid_Result.ColWidth(0) = 9000
        Grid_Result.ColWidth(1) = 1
    Case "TEST"
        Grid_Result.ColWidth(0) = 5000
        Grid_Result.ColWidth(1) = 5000
End Select
pic_PrintResult.Visible = KO
cmd_Detail.Enabled = KO
pic_print.Visible = KO
DoEvents
ml_TotCount = 0

Set mo_Fetch = New Fetch
mo_Fetch.EnvironmentIdentifier = gl_Environment
mo_Fetch.DatabaseIdentifier = gl_Database

If mo_Fetch.ExecuteQry(gut_Param.Str21, True) Then
    ml_TotCount = mo_Fetch.RowCount
    
    mi_Status = SQL_SUCCESS
    pic_next25.Visible = FillMore25
End If
If ml_TotCount > 0 Then
' If at least one result is found
    pic_PrintResult.Visible = True
    pic_Excel.Visible = True
End If

If ml_TotCount = 0 Then
    lbl_result = Query.lbl_result & " " & "0 / " & ml_TotCount & " " & Query.lbl_Result2
Else
    lbl_result = Query.lbl_result & " " & Grid_Result.Rows & " / " & ml_TotCount & " " & Query.lbl_Result2
End If
Exit Sub

suite:
StdError
End Sub
Private Sub pic_refresh_Click()

MouseOff
FillResults
MouseOn

End Sub
