Problema con Macros, Botón Procesar
HOLa AYUDENME Caso de VIDa o MUERTE pero más de MUERTE : Tengo un Excel con 3 HOJAS ( HOja1=Total, Hoja2=Lima, Hoja3=Provincia ) con una MACROS con el Botón Procesar y un ERROR que no se que pasa miren!... :(
Private Sub CmdProcesar_Click()
Dim CMDVENTA As ADODB.Command
Dim CMDCOMBOS As ADODB.Command
Dim RSVENTA As New ADODB.Recordset
Dim RSCOMBOS As New ADODB.Recordset
'Acelerar Macros'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'Fin de la Aceleracion'
FECINI = TxtFecIni.Value
FECFIN = TxtFecfin.Value
SUBCC = CboSubCanalCtrl.Value
Hoja1.Cells(4, 2) = "TOTAL " & SUBCC
Set cn = New ADODB.Connection
With cn
.CursorLocation = adUseClient
.ConnectionString = "PROVIDER=SQLOLEDB;DATA SOURCE=AJINOMOTONT2;INITIAL CATALOG=prdsap;USER ID=PLANINF; PASSWORD=INFORMACION; "
.Open
If CboSubCanalCtrl.Value <> "" Then
SQL1 = "select dmtdi_fecha.anno, dmtdi_fecha.mes, dmtdi_materiales.cod_jerarquia_mat AS ID_PRESENTACION, dmtfa_ventas.cod_canal, "
SQL1 = SQL1 + "dmtdi_canal.dsc_canal, dmtfa_ventas.cod_org_ventas,(left(dmtdi_zona_ventas.dsc_zona_ventas,4)) as [Desc_Zona], (left(dmtdi_zona_ventas.dsc_zona_ventas,4)) as [ZONAS_CONTROL], "
SQL1 = SQL1 + "dmtdi_zona_ventas.dsc_zona_ventas, dmtfa_ventas.cod_solicitante,dmtfa_ventas.cod_material,dmtfa_ventas.cod_jerarquia_material, "
SQL1 = SQL1 + "(left(dmtfa_ventas.cod_jerarquia_material,3)+ ' ' + left(dmtdi_materiales.dsc_material,3)) as [Cod_Clase], "
SQL1 = SQL1 + "dmtfa_ventas.cod_grupo_vendedores,dmtdi_grupo_vendedores.dsc_grupo_vendedores,dmtdi_oficina_ventas.cod_oficina_ventas, "
SQL1 = SQL1 + "dmtdi_oficina_ventas.dsc_oficina_ventas,SUM(dmtfa_ventas.ctd_neto_ventas) AS peso "
SQL1 = SQL1 + "FROM dmtfa_ventas inner join dmtdi_materiales on dmtfa_ventas.cod_MATERIAL=dmtdi_materiales.cod_MATERIAL inner join dmtdi_canal "
SQL1 = SQL1 + "on dmtfa_ventas.cod_canal=dmtdi_canal.cod_canal inner join dmtdi_zona_ventas on dmtfa_ventas.cod_zona_ventas=dmtdi_zona_ventas.cod_zona_ventas inner join dmtdi_grupo_vendedores "
SQL1 = SQL1 + "on dmtfa_ventas.cod_grupo_vendedores=dmtdi_grupo_vendedores.cod_grupo_vendedores inner join dmtdi_clase_posicion ON dmtfa_ventas.cod_tipo_posicion = dmtdi_clase_posicion.cod_clase_posicion inner join dmtdi_oficina_ventas "
SQL1 = SQL1 + "on dmtfa_ventas.cod_oficina_ventas=dmtdi_oficina_ventas.cod_oficina_ventas inner join dmtdi_fecha on dmtfa_ventas.fch_documento=dmtdi_fecha.id_fecha "
SQL1 = SQL1 + "WHERE dmtfa_ventas.fch_documento between convert(datetime,' " & FECINI & " ',103) and convert (datetime,' " & FECFIN & "',103) and dbo.dmtdi_clase_posicion.dsc_tipo_posicion IN ('VENTA')and "
SQL1 = SQL1 + "dmtfa_ventas.cod_canal<>'50'and dmtfa_ventas.cod_org_ventas='1100' "
SQL1 = SQL1 + "GROUP BY dmtdi_fecha.anno,dmtdi_fecha.mes,dmtdi_materiales.cod_jerarquia_mat,dmtfa_ventas.cod_canal, dmtdi_canal.dsc_canal,dmtfa_ventas.cod_org_ventas, dmtfa_ventas.cod_zona_ventas, "
SQL1 = SQL1 + "dmtdi_zona_ventas.dsc_zona_ventas, dmtfa_ventas.cod_solicitante, dmtfa_ventas.cod_material,dmtfa_ventas.cod_jerarquia_material,dmtdi_materiales.dsc_material,dmtfa_ventas.cod_grupo_vendedores, "
SQL1 = SQL1 + "dmtdi_grupo_vendedores.dsc_grupo_vendedores, dmtdi_oficina_ventas.cod_oficina_ventas, dmtdi_oficina_ventas.dsc_oficina_ventas "
SQL1 = SQL1 + "ORDER BY dmtdi_fecha.anno,dmtdi_fecha.mes,dmtdi_materiales.cod_jerarquia_mat "
Set CMDVENTA = New ADODB.Command
With CMDVENTA
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = SQL1
.CommandTimeout = 180
Set RSVENTA = CMDVENTA.Execute
X = RSVENTA.RecordCount
End With
Limpiar
ULTIMO = 170
intNumeroHojas = ThisWorkbook.Sheets.Count
If I <> 2 Then I = 2 Else I = 2
'LLENAR VENTAS
If X <> 0 Then
For CODV = 1 To RSVENTA.RecordCount
ANNO = RSVENTA.Fields("ANNO").Value
MES = RSVENTA.Fields("MES").Value
IDZONAC = RSVENTA.Fields("Desc_Zona").Value
ZONAC = RSVENTA.Fields("ZONAS_CONTROL").Value
CODIGO = RSVENTA.Fields("ID_PRESENTACION").Value
For NCOL = 4 To 90
If IsDate(Hoja1.Cells(12, NCOL)) = False Then EXFECHA = 0 Else EXFECHA = Hoja1.Cells(12, NCOL)
EXANNO = Year(EXFECHA)
EXMES = Month(EXFECHA)
If EXANNO = ANNO And EXMES = MES Then
COL = NCOL
Exit For
End If
Next
If ThisWorkbook.Sheets(I).Range("B4") = "" Then
ThisWorkbook.Sheets(I).Range("B4") = IDZONAC
ThisWorkbook.Sheets(I).Range("B6") = ZONAC
ThisWorkbook.Sheets(I).Name = ZONAC
For CODEX = 13 To ULTIMO
CODIGOEXCEL = ThisWorkbook.Sheets(I).Cells(CODEX, 1)
If CODIGOEXCEL = CODIGO Then
NFILA = CODEX
ThisWorkbook.Sheets(I).Cells(NFILA, COL) = ThisWorkbook.Sheets(I).Cells(NFILA, COL) + RSVENTA.Fields("PESO").Value
Exit For
End If
Next
ElseIf ThisWorkbook.Sheets(I).Range("B4") = IDZONAC Then
For CODEX = 13 To ULTIMO
CODIGOEXCEL = ThisWorkbook.Sheets(I).Cells(CODEX, 1)
If CODIGOEXCEL = CODIGO Then
NFILA = CODEX
ThisWorkbook.Sheets(I).Cells(NFILA, COL) = ThisWorkbook.Sheets(I).Cells(NFILA, COL) + RSVENTA.Fields("PESO").Value
Exit For
End If
Next
ElseIf ThisWorkbook.Sheets(I).Range("B4") <> IDZONAC Then
I = I + 2
ThisWorkbook.Sheets(I).Range("B4") = IDZONAC
ThisWorkbook.Sheets(I).Range("B6") = ZONAC
ThisWorkbook.Sheets(I).Name = ZONAC ' Aquii sta el ERRO, PLEASE'
For CODEX = 13 To ULTIMO
CODIGOEXCEL = ThisWorkbook.Sheets(I).Cells(CODEX, 1)
If CODIGOEXCEL = CODIGO Then
NFILA = CODEX
ThisWorkbook.Sheets(I).Cells(NFILA, COL) = ThisWorkbook.Sheets(I).Cells(NFILA, COL) + RSVENTA.Fields("PESO").Value
Exit For
End If
Next
End If
RSVENTA.MoveNext
Next
End If
I = I + 1
NH = 0
For NH = I To intNumeroHojas
ThisWorkbook.Sheets(I).Name = NH
I = I + 1
Next
MsgBox "FIN DEL PROCESO", vbInformation, "PROCESO"
I = 2
End If
End With
'Acelerar Nuestra Macros
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.CalculateBeforeSave = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
'Fin de la Aceleracion'
End Sub
************************ Xfa un Capo q me ayude a Solucionar este ERROR, soy d Lima Peru. Mi Correo es = [email protected]...... Regalo PANETONNNNNNNNN solo LIMA, PERU:)
