'Nome       : BalSoc.sql
'Tipo       : LST
'Data       : 2004/02/26
'Versao     : 1.0
'Descricao  : Balanco Social - Exportacao XLS

'==============================================================================
'#VER - Historia de modificacoes
'==============================================================================
'- Versao : 1.0   2004/??/?? --------------------------------------------------
'Versao base


'==============================================================================
#DEF - Definicao global do documento
'==============================================================================
Caracteres invalidos             [CarInv]=#
Subtotalizadores                 [SbtNiv]=2
##


'==============================================================================
#ESP - Campos especificos
'==============================================================================
##



'==============================================================================
#SQL - Comandos SQL
'==============================================================================
'Base de dados           [BD]=EmpFic$("EMP","Cemp,Emp_Dat.mdb")
Base de dados           [BD]=EmpFic$("EMP","Gpe,Gpe.mdb")


'- generico -------------------------------------------------------------------
Forcar Listagem               [Cmd]=FrcLst=+
+SELECT TOP 1 * FROM GpeMst

##


'==============================================================================
#DOC - Configuracao do documento
'==============================================================================
Tipo                       [DocTip]=SQL
Nome                       [DocNom]=BalSoc,Balanço Social (XLS)

'formato
Saida/Impressora           [DocPrt]=
Linhas por pagina          [DocLpg]=50
Colunas por linha          [DocCol]=78
Formato do papel           [DocPap]=72L
Ajustar pagina             [DocApg]=0
Especifico do documento    [DocEsp]=

'funcoes de listagem
Base para documento         [FxDOC]=BalSoc
Listar cabecalho            [FxCAB]=BalSoc_Cab
Listar linhas               [FxLIN]=BalSoc_Lin,0
Listar fim                  [FxFIM]=BalSoc_Fim

Matriz auxiliar            [DocMat]=BalSoc.xls

'controlo de listagem SQL
Gerador de dados a listar  [SQLDat]=FrcLst
Subtotalizadores           [SQLSbt]=
##


'==============================================================================
#VAR - Variaveis
'==============================================================================
Tipo     = MemTxt$(1)                                 '?
Pag      = Doc_CntPag                                 'contador de paginas
DataExt  = FrmVal$(Sig_DtHoje,45,0)                   'data por extenso

##


'==============================================================================
#PGM - Programa/Funcoes
'==============================================================================
'---------------------------------------------------------->'Comentario (61)
'------------------------------------------------------->'Comentario (58)
'---------------------------------------------------->'Comentario (55)
'------------------------------------------------->'Comentario (52)
'------------------------------------->'Comentario (40)

Sub FxIni 'funcao de inicializacao
cnt=0                                              'limpar contador
'msgbox "","FxIni",""
end sub


Sub FxFim 'funcao de finalizacao
res = XlsFim(0)                                    'terminar EXCEL
'msgbox "","FxFim",""
end sub


Sub Lst_AJT 'ajuste
end sub


'-----------------------------------------------------------------------------
' XLS - Funcoes comuns
'-----------------------------------------------------------------------------
Sub Xls_DocIni 'inicializar documento
dfi$ = FicEmp$("EMP","Ext","dExcel",cmo$)          'directorio de documentos EXCEL
nfi$ = "RND:BalSoc.xls"                            'nome do ficheiro
cmo$ = SigCmoCur$("MIX")                           'modulo corrente
ficDoc$ = FicTmp$(dfi$, nfi$)                      'ficheiro para documento
res = DirCri("D", dfi$)                            'criar directorio para documento

xlsMatNom$ = DocOpc$("DocMat")                     'nome do ficheiro matriz
xlsMat$    = DocOpc$("DocMat+SBT")                 'endereco do ficheiro matriz

res = FicCop(xlsMat$, ficDoc$)                     'criar ficheiro (copia de matriz)

res = XlsPrp(0)                                    'preparar EXCEL
res = XlsDocLer(ficDoc$)                           'ler ficheiro

'res = XlsDocCri("")                                'criar documento
end sub


Sub Xls_DocFim 'terminar documento
'res = XlsLinEli(xlsLin, 1)                         'eliminar linha - ultima
'res = XlsLinEli(xlsLba, 1)                         'eliminar linha - primeira

'res = XlsWks(1)                                    'activar worksheet

res = XlsDocDir$("A", dfi$)                        'activar directorio
res = XlsDocGrv(ficDoc$)                           'gravar ficheiro

'res = XlsPrt(1)                                    'listar worksheet
res = XlsVer(0)                                    'mostrar EXCEL - normal
'res = XlsVer(1)                                    'mostrar EXCEL - maximizado
res = XlsLib(0)                                    'libertar EXCEL
end sub


'-----------------------------------------------------------------------------
'- Balanco Social ------------------------------------------------------------
'-----------------------------------------------------------------------------
Sub BalSoc_DocIni 'inicializar documento
call Xls_DocIni                                    'inicializar documento
call BalSoc_Prep                                   'preparar
end sub


Sub BalSoc_DocFim 'terminar documento
linIni = linBav                                    'linha inicial
linFim = linCnt                                    'linha final

'mostrar
call Xls_DocFim                                    'terminar/mostrar documento
end sub


Sub BalSoc_Prep 'preparar para listar
end sub


Sub BalSoc_Cab 'cabecalho
end sub


Sub BalSoc_Lin 'linha
'lstDt$  = FrmDt$("", Sig_DtHoje)                   'data para listagem
lstDt$  = FrmDt$("EXT", Sig_DtHoje)                'data para listagem
DtAno   = FrmDt$("A4",Sig_DtHoje)                  'ano

empNum$ = Emp_Inf_Cod$                             'numero da empresa
empNom$ = Emp_Inf_Nome$                            'nome da empresa

'listar
call BalSoc_F01                                    'folha 1
call BalSoc_F02                                    'folha 2
call BalSoc_F03                                    'folha 3
end sub


Sub BalSoc_F01 'folha 1
'folha 1
res = XlsWks("Folha1")                             'activar worksheet
res = XlsIdeLst("F1_Ano", DtAno)                   'registar ano

'-----------------------------------------------------------------------------
' Dados da empresa
'-----------------------------------------------------------------------------
EmpNom$   = Emp_Inf_Nome$                          'nome
EmpMor$   = Emp_Inf_Morada$                        'morada
EmpLoc$   = Emp_Inf_Local$                         'localidade
EmpCpo$   = Emp_Inf_Cpost$                         'codigo postal
EmpTel$   = Emp_Inf_Telef$                         'telefone
EmpFax$   = Emp_Inf_Fax$                           'fax
EmpDis$   = Emp_Inf_Dist$                          'distrito
EmpConc$  = Emp_Inf_Conc$                          'concelho
EmpMail$  = Emp_Inf_Email$                         'correio electronico
EmpCtrb$  = Emp_Inf_Contrib$                       'contribuinte
EmpActi$  = Emp_inf_Activ$                         'actividade
EmpNpes   = Emp_Inf_NumPes                         'numero de pessoas
EmpNat$   = Emp_Inf_NatJur$                        'natureza juridica

'registar dados da empresa
res     = XlsIdeLst("F1_Nome", EmpNom$)            'registar nome
res     = XlsIdeLst("F1_Morada", EmpMor$)          'registar morada
res     = XlsIdeLst("F1_Local", EmpLoc$)           'registar local
res     = XlsIdeLst("F1_Cpost", EmpCpo$)           'registar codigo postal
res     = XlsIdeLst("F1_Telef", EmpTel$)           'registar telefone
res     = XlsIdeLst("F1_Fax", EmpFax$)             'registar fax
res     = XlsIdeLst("F1_Dist", EmpDis$)            'registar distrito
res     = XlsIdeLst("F1_Conc", EmpConc$)           'registar concelho
res     = XlsIdeLst("F1_Mail", EmpMail$)           'registar mail
res     = XlsIdeLst("F1_Npc", EmpCtrb$)            'registar contribuinte
res     = XlsIdeLst("F1_Activ", EmpActiv$)         'registar actividade
res     = XlsIdeLst("F1_NatJur", EmpNat$)          'registar actividade
end sub


Sub BalSoc_F02 'folha 2
'folha 2
res = XlsWks("Folha2")                             'activar worksheet

'reparticao de efectivos
chb$ = "F2_1_1_"                                   'chave base

for tpc = 1 to 4
xTpc$ = NumTxt$(tpc, 1)                            'numero em texto

for cat = 1 to 8
xCat$ = NumTxt$(cat, 1)                            'numero em texto

nHom = VBS_RepEfe(tpc, "M", cat)                   'numero de homens
nMul = VBS_RepEfe(tpc, "F", cat)                   'numero de mulheres

chHom$ = chb$ + xTpc$ + "_H" + xCat$               'chave para homens
chMul$ = chb$ + xTpc$ + "_M" + xCat$               'chave para mulheres

res = XlsIdeLst(chHom$, nHom)                      'registar numero de homens
res = XlsIdeLst(chMul$, nMul)                      'registar numero de mulheres
next
next


'- estrutura etaria -----------------------------------------------------------
chb$ = "F2_1_3_"                                   'chave base
dtBas = Sig_DtHoje                                 'data base

escNum = 0                                         'inicializar escalao
dtLim1 = 0                                         'data limite 1

dtLim2 = 15                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 17                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 24                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 29                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 34                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 39                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 44                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 49                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 54                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 59                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 61                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 64                                        'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria

dtLim2 = 9999                                      'data limite 2
call BalSoc_F02_EA                                 'folha 2 - estrutura etaria
end sub


Sub BalSoc_F02_EA 'folha 2 - estrutura etaria
escNum = escNum + 1                                'contar escalao
xEsc$  = NumTxt$(escNum, 2)                        'numero em texto

nHom = VBS_TrbLdt("NAS", dtBas, dtLim1, dtLim2, "M")   'trabalhadores - homens
nMul = VBS_TrbLdt("NAS", dtBas, dtLim1, dtLim2, "F")   'trabalhadores - mulheres

chHom$ = chb$ + xEsc$ + "_H1"                      'chave para homens
chMul$ = chb$ + xEsc$ + "_M1"                      'chave para mulheres

res = XlsIdeLst(chHom$, nHom)                      'registar numero de homens
res = XlsIdeLst(chMul$, nMul)                      'registar numero de mulheres

dtLim1 = dtLim2                                    'preparar ciclo seguinte
end sub


Sub BalSoc_F03 'folha 3
'folha 2
res = XlsWks("Folha3")                             'activar worksheet

'- nivel de antiguidade -------------------------------------------------------
chb$ = "F3_1_5_"                                   'chave base
dtBas = Sig_DtHoje                                 'data base

escNum = 0                                         'inicializar escalao
dtLim1 = 0                                         'data limite 1

dtLim2 = 1                                         'data limite 2
call BalSoc_F03_NA                                 'folha 3 - nivel de antiguidade

dtLim2 = 2                                         'data limite 2
call BalSoc_F03_NA                                 'folha 3 - nivel de antiguidade

dtLim2 = 5                                         'data limite 2
call BalSoc_F03_NA                                 'folha 3 - nivel de antiguidade

dtLim2 = 10                                        'data limite 2
call BalSoc_F03_NA                                 'folha 3 - nivel de antiguidade

dtLim2 = 15                                        'data limite 2
call BalSoc_F03_NA                                 'folha 3 - nivel de antiguidade

dtLim2 = 9999                                      'data limite 2
call BalSoc_F03_NA                                 'folha 3 - nivel de antiguidade


'- zona de origem -------------------------------------------------------------
chb$ = "F3_1_6_"                                   'chave base

for zona = 1 to 4
xZon$ = NumTxt$(zona, 1)                           'numero em texto

nHom = VBS_ZonOrg(zona, "M")                       'numero de homens
nMul = VBS_ZonOrg(zona, "F")                       'numero de mulheres

chHom$ = chb$ + xZon$ + "_H1"                      'chave para homens
chMul$ = chb$ + xZon$ + "_M1"                      'chave para mulheres

res = XlsIdeLst(chHom$, nHom)                      'registar numero de homens
res = XlsIdeLst(chMul$, nMul)                      'registar numero de mulheres
next


'- niveis de habilitacao ------------------------------------------------------
chb$ = "F3_1_8_"                                   'chave base

for hab = 1 to 9
xHab$ = NumTxt$(hab, 1)                            'numero em texto

nHom = VBS_NivHab(hab, "M")                        'numero de homens
nMul = VBS_NivHab(hab, "F")                        'numero de mulheres

chHom$ = chb$ + xHab$ + "_H1"                      'chave para homens
chMul$ = chb$ + xHab$ + "_M1"                      'chave para mulheres

res = XlsIdeLst(chHom$, nHom)                      'registar numero de homens
res = XlsIdeLst(chMul$, nMul)                      'registar numero de mulheres
next


'- contratados a termo --------------------------------------------------------
chb$ = "F3_1_9_"                                   'chave base

for ctr = 0 to 4
xCtr$ = NumTxt$(ctr, 1)                            'numero em texto

for cat = 1 to 8
xCat$ = NumTxt$(cat, 1)                            'numero em texto

nHom = VBS_CtrTer(ctr, cat, "M")                   'numero de homens
nMul = VBS_CtrTer(ctr, cat, "F")                   'numero de mulheres

chHom$ = chb$ + xCtr$ + "_H" + xCat$               'chave para homens
chMul$ = chb$ + xCtr$ + "_M" + xCat$               'chave para mulheres

res = XlsIdeLst(chHom$, nHom)                      'registar numero de homens
res = XlsIdeLst(chMul$, nMul)                      'registar numero de mulheres
next
next
end sub


Sub BalSoc_F03_NA 'folha 3 - nivel de antiguidade
'msgbox "","F3/NA",""

escNum = escNum + 1                                'contar escalao
xEsc$  = NumTxt$(escNum, 1)                        'numero em texto

nHom = VBS_TrbLdt("ADM", dtBas, dtLim1, dtLim2, "M")   'trabalhadores - homens
nMul = VBS_TrbLdt("ADM", dtBas, dtLim1, dtLim2, "F")   'trabalhadores - mulheres

chHom$ = chb$ + xEsc$ + "_H1"                      'chave para homens
chMul$ = chb$ + xEsc$ + "_M1"                      'chave para mulheres

res = XlsIdeLst(chHom$, nHom)                      'registar numero de homens
res = XlsIdeLst(chMul$, nMul)                      'registar numero de mulheres

dtLim1 = dtLim2                                    'preparar ciclo seguinte
'msgbox "","F3/NA 2",""
end sub


##


'==============================================================================
#VBS - VB Script
'==============================================================================
'---------------------------------------------------------->'Comentario (61)
'------------------------------------------------->'Comentario (52)
'------------------------------------->'Comentario (40)

'- variaveis globais ----------------------------------------------------------
'dim var                            'variavel


'------------------------------------------------------------------------------
'Funcoes
'------------------------------------------------------------------------------
Function RepEfe(tpc, sex, cat) 'reparticao de efectivos
'tpc        - tipo de contrato
'sex        - sexo
'cat        - categoria

sql =       "SELECT Count(*) "
sql = Sql + "FROM GpeMst INNER JOIN GpeMstEx ON GpeMst.[Trb$] = GpeMstEx.[trb$] "
sql = Sql + "WHERE BlsTpc = "  & tpc & " "
sql = Sql + "AND Sexo$ = '" & sex & "' "
sql = Sql + "AND BlsCat = " & cat & " "

res = FxPre.SqlCalc("N", sql)          'calcular valor

RepEfe = res                           'devolver resultado
end function


Function ZonOrg(zona, sex) 'trabalhadores zona origem
'zona       - zona de origem
'sex        - sexo

sql =       "SELECT Count(*) "
sql = Sql + "FROM GpeMst INNER JOIN GpeMstEx ON GpeMst.[Trb$] = GpeMstEx.[trb$] "
sql = Sql + "WHERE BlsZonOrg = "  & zona & " "
sql = Sql + "AND Sexo$ = '" & sex & "' "

res = FxPre.SqlCalc("N", sql)          'calcular valor

ZonOrg = res                           'devolver resultado
end function


Function NivHab(hab, sex) 'niveis de habilitacao
'hab        - nivel habilitacao
'sex        - sexo

sql =       "SELECT Count(*) "
sql = Sql + "FROM GpeMst INNER JOIN GpeMstEx ON GpeMst.[Trb$] = GpeMstEx.[trb$] "
sql = Sql + "WHERE BlsHabNiv = "  & hab & " "
sql = Sql + "AND Sexo$ = '" & sex & "' "

res = FxPre.SqlCalc("N", sql)          'calcular valor

NivHab = res                           'devolver resultado
end function


Function CtrTer(ctr, cat, sex) 'trabalhadores zona origem
'ctr        - tipo de contrato
'cat        - categoria
'sex        - sexo

sql =       "SELECT Count(*) "
sql = Sql + "FROM GpeMst INNER JOIN GpeMstEx ON GpeMst.[Trb$] = GpeMstEx.[trb$] "
sql = Sql + "WHERE BlsCtrTer = "  & ctr & " "
sql = Sql + "AND BlsCat = " & cat & " "
sql = Sql + "AND Sexo$ = '" & sex & "' "

res = FxPre.SqlCalc("N", sql)          'calcular valor

CtrTer = res                           'devolver resultado
end function


Function TrbLdt(mo, dtb, ano1,ano2, sex) 'trabalhadores por limite de data
'mo         - modo da data
'dtb        - data base
'ano1       - limite inicial de anos
'ano2       - limite final   de anos
'sex        - sexo

'msgbox "TrbLdt 1"


'data a usar
select case mo
case "ADM"              'admissao
   varDt = "DtAdmi"                    'variavel a usar

case "PRO"              'promocao
   varDt = "DtProm"                    'variavel a usar

case else               '<NAS>, outros - nascimento
   varDt = "DtNasc"                    'variavel a usar
end select

'msgbox "TrbLdt 2"

'limite de data
vSom1 = ano1 * 100000000000             'valor a somar - limite inicial
vSom2 = ano2 * 100000000000             'valor a somar - limite inicial

dtIni = dtb - vSom1                     'data inicial
dtFim = dtb - vSom2                     'data final

'msgbox "TrbLdt 3"

'gerar SQL
sql =       "SELECT Count(*) "
sql = Sql + "FROM GpeMst INNER JOIN GpeMstEx ON GpeMst.[Trb$] = GpeMstEx.[trb$] "
sql = Sql + "WHERE " & varDt & " > "  & dtFim & " AND " & varDt & " <= "  & dtIni & " "
sql = Sql + "AND Sexo$ = '" & sex & "' "

'msgbox "TrbLdt 4"
res = FxPre.SqlCalc("N", sql)          'calcular valor

TrbLdt = res                           'devolver resultado
end function


'- Consultar valores ----------------------------------------------------------
Function DocConEsp(ide) 'consultar opcao especifica de documento
'ide        - identificador 

res = FxPre.DocConEsp("T", ide)        'consultar

'txm = "Especifico DOC: " & ide & "=" & res
'msgbox txm

DocConEsp = res                        'devolver valor
end function


Function DocConOpc(ide) 'consultar opcao de documento
'ide        - identificador 

res = FxPre.DocConOpc("T", ide)        'consultar

'txm = "Opcao DOC: " & ide & "=" & res
'msgbox txm

DocConOpc = res                        'devolver valor
end function


Function DocConOpcEsp(ide) 'consultar opcao especifica do documento
'ide        - identificador 

res = FxPre.DocConOpcEsp("T", ide)     'consultar

'txm = "Opcao DOC/ESP: " & ide & "=" & res
'msgbox txm

DocConOpcEsp = res                     'devolver valor
end function


Function DocConVar(ide) 'consultar variavel do documento
'ide        - identificador 

res = FxPre.DocConVar("T", ide)        'consultar

'txm = "Variavel: " & ide & "=" & res
'msgbox txm

DocConVar = res                        'devolver valor
end function


'- Diversos -------------------------------------------------------------------
Function ExeFxDoc(fx) 'executar funcao do documento
'fx         - nome da funcao a executar

FxPre.FxDoc(fx)                        'executar funcao do documento
res = 1                                'resultado

ExeFxDoc = res                         'retornar resultado
end function

##


