Option Explicit
Public CN As ADODB.Connection
Public miServidor As String, miUsuario As String, miPass As String, miBDD As String, miEmpresa As String
Public miHoja As Boolean, miDocum As Long
Public Final1 As Integer
Public miConta As Integer
Public miAgente As Integer
Dim Fila, Final As Long
Private Sub Auto_Open()
Hoja8.Select
Call Arranque
End Sub
Public Sub Arranque()
Dim SQL As String
Dim Connected As Boolean
Dim Resp As Long
Hoja8.Select
miServidor = Hoja6.Cells(6, 2).Value
miUsuario = Hoja6.Cells(7, 2).Value
miPass = Hoja6.Cells(8, 2).Value
miHoja = True
Connected = Connect(miServidor, miUsuario, miPass, "CompacWAdmin")
If Connected Then '1
Call Query_Empresas
Call Disconnect
Else
Resp = MsgBox("Parametros Incorrectos!!!", vbCritical, "Error")
End If
End Sub
Public Sub Principal()
Dim SQL As String
Dim Connected As Boolean
Dim fIni As String, fFin As String
Dim miAlmacen As Long
Hoja6.Cells(9, 2).Calculate
miEmpresa = Hoja6.Cells(5, 2).Value
miServidor = Hoja6.Cells(6, 2).Value
miUsuario = Hoja6.Cells(7, 2).Value
miPass = Hoja6.Cells(8, 2).Value
miBDD = Hoja6.Cells(9, 2).Value
Connected = Connect(miServidor, miUsuario, miPass, miBDD)
If Connected Then
Call Query_Ejercicios
Call Disconnect
Else
MsgBox "No podemos Conectarnos a Ejercicios!"
End If
Connected = Connect(miServidor, miUsuario, miPass, miBDD)
If Connected Then
Call Query_Almacenes
Call Disconnect
Else
MsgBox "No podemos Conectarnos a Ejercicios!"
End If
'******** Documentos
miEmpresa = Hoja6.Cells(5, 2).Value
miServidor = Hoja6.Cells(6, 2).Value
miUsuario = Hoja6.Cells(7, 2).Value
miPass = Hoja6.Cells(8, 2).Value
miBDD = Hoja6.Cells(9, 2).Value
fIni = Hoja6.Range("B3").Value fFin = Hoja6.Range("B4").Value
miHoja = True
Connected = Connect(miServidor, miUsuario, miPass, miBDD)
If Connected Then
Call Query_Documentos
Call Disconnect
Final = Hoja1.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row 'GetUltimoR(Hoja1)
For miConta = 2 To Final
Hoja9.Cells(miConta, 1) = Hoja1.Cells(miConta, 5)
Next
ActiveWorkbook.Names.Add Name:="misClientes", RefersTo:=Hoja9.Range("A2:A" & Final) Hoja9.Range("misClientes").RemoveDuplicates Columns:=1, Header:=xlNo
Else
MsgBox "No podemos Conectarnos a Documentos!"
End If
'******** Movimientos de Traspaso
Hoja2.Cells.ClearContents
Final1 = Hoja2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row + 1
Connected = Connect(miServidor, miUsuario, miPass, miBDD)
If Connected Then
Call Query_Movimientos_Traspasos
Call Disconnect
Else
MsgBox "No podemos Conectarnos a Movimientos!"
End If
'******** Relaciona los movimientos del almacen del Reporte (Movimientos Ocultos)
Dim Ren1 As Long, Ren As Long
Ren1 = 2
miAlmacen = Hoja6.Cells(12, 2).Value
Final1 = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
For Ren = 2 To Final1
If Hoja2.Cells(Ren, 6).Value = miAlmacen Then
If Hoja2.Cells(Ren, 10).Value = 0 Then
Do While Hoja2.Cells(Ren, 3).Value <> Hoja2.Cells(Ren1, 11).Value
Ren1 = Ren1 + 1
Loop
Hoja2.Cells(Ren, 14).Value = Hoja2.Cells(Ren1, 6).Value
Hoja2.Cells(Ren, 15).Value = Hoja2.Cells(Ren1, 5).Value
Ren1 = 1
Else
Do While Hoja2.Cells(Ren, 11).Value <> Hoja2.Cells(Ren1, 3).Value
Ren1 = Ren1 + 1
Loop
Hoja2.Cells(Ren, 4).Value = Hoja2.Cells(Ren1, 4).Value
Hoja2.Cells(Ren, 14).Value = Hoja2.Cells(Ren1, 6).Value
Hoja2.Cells(Ren, 15).Value = Hoja2.Cells(Ren1, 5).Value
Ren1 = 1
End If
End If
Next
'******** Productos
'Ultimo renglon de Productos
Final = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
'Ciclo para los documentos
For miConta = 2 To Final
' Toma el cid del procuto para buscar clave y nombre
miDocum = Hoja2.Cells(miConta, 7).Value
Connected = Connect(miServidor, miUsuario, miPass, miBDD)
If Connected Then
Call Query_Productos
Call Disconnect
Else
MsgBox "No podemos Conectarnos a Productos!"
End If
Next
'******** Sustituye el numero del Documento por el cidDocumento
Final = Hoja1.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Final1 = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
For miConta = 2 To Final
For Ren1 = 2 To Final1
If Hoja2.Cells(Ren1, 4).Value = Hoja1.Cells(miConta, 1).Value Then
Hoja2.Cells(Ren1, 1).Value = Hoja1.Cells(miConta, 4).Value
Hoja2.Cells(Ren1, 4).Value = Hoja1.Cells(miConta, 3).Value
End If
Next
Next
'******** Conceptos
'Ultimo renglon de Productos
Final = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
'Ciclo para los documentos
For miConta = 2 To Final
Hoja2.Cells(miConta, 2).Value = "Traspaso"
Next
'******** Busca el Nombre del Almacen del movimiento oculto
Final = Hoja4.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
Final1 = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
For miConta = 3 To Final
For Ren1 = 2 To Final1
If Hoja2.Cells(Ren1, 14).Value = Hoja4.Cells(miConta, 3).Value Then
Hoja2.Cells(Ren1, 14).Value = Hoja4.Cells(miConta, 1).Value
End If
Next
Next
'******* Genera Reporte de Movimientos ********
Dim Filas As Long, miConta2 As Long
Dim miComision As Double, miFactAct As Long, miFactAnt As Long
Dim Filas_Ini As Long, miTot_Gral As Long
Hoja3.Select
Hoja3.Range("A8:K2000").ClearContents
Hoja3.Cells(8, 1).Value = "Almacén"
Hoja3.Cells(9, 1).Value = "Nombre:"
Filas = Hoja4.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
For miTot_Gral = 3 To Filas
If Hoja4.Cells(miTot_Gral, 3).Value = Hoja6.Cells(12, 2).Value Then
Hoja3.Cells(8, 2).Value = Hoja4.Cells(miTot_Gral, 1).Value
Hoja3.Cells(9, 2).Value = Hoja4.Cells(miTot_Gral, 2).Value
End If
Next
Hoja3.Cells(11, 1).Value = "'36 "
Hoja3.Cells(11, 2).Value = "Traspasos"
Hoja3.Cells(11, 3).Value = "Traspasos"
Filas = 12
For miTot_Gral = 1 To 13
Hoja3.Cells(6, miTot_Gral).Font.Bold = True
'Hoja3.Cells(6, miTot_Gral).HorizontalAlignment = xlCenter
Next
miTot_Gral = 0
Hoja3.Cells(1, 6) = miEmpresa
Hoja3.Cells(2, 11) = Day(Date) _
& "/" & Application.VLookup(Month(Date), Range("Mes_corto"), 3, False) _ & "/" & Year(Date)
Hoja3.Cells(3, 1) = "Moneda: Peso Mexicano Del: " & _
Mid(fIni, 2, 10) & " al: " & Mid(fFin, 2, 10)
'Total de Documentos Ultimo renglon de Documentos
Final = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row 'GetUltimoRm(Hoja2)
'Ciclo para generar el reporte por Agente
miAlmacen = Hoja6.Cells(12, 2).Value
For miConta = 2 To Final
If Hoja2.Cells(miConta, 14).Value <> "" Then
' Ciclo de los movimientos para generar el reporte
Hoja3.Cells(Filas, 1) = Day(Hoja2.Cells(miConta, 1)) _
& "/" & Application.VLookup(Month(Hoja2.Cells(miConta, 1)), Range("Mes_corto"), 3, False) _ & "/" & Year(Hoja2.Cells(miConta, 1))
Hoja3.Cells(Filas, 2) = Hoja2.Cells(miConta, 2)
Hoja3.Cells(Filas, 3) = Hoja2.Cells(miConta, 14)
Hoja3.Cells(Filas, 4) = Hoja2.Cells(miConta, 4)
Hoja3.Cells(Filas, 6) = Hoja2.Cells(miConta, 7)
Hoja3.Cells(Filas, 7) = Hoja2.Cells(miConta, 8)
Hoja3.Cells(Filas, 8) = IIf(Hoja2.Cells(miConta, 15) = 1, 1, -1) * Hoja2.Cells(miConta, 9)
Hoja3.Cells(Filas, 9) = 0
Hoja3.Cells(Filas, 10) = IIf(Hoja2.Cells(miConta, 15) = 1, 1, -1) * Hoja2.Cells(miConta, 12)
Hoja3.Cells(Filas, 11) = IIf(Hoja2.Cells(miConta, 15) = 1, "Entrada", "Salida")
Filas = Filas + 1
End If
Next
MsgBox "Reporte Generado!"
Unload frmPrincipal
End Sub
Crear cuenta
