Private Sub BtnAceptar_Click()
Application.ScreenUpdating = False
Dim chk1 As String
Dim chk2 As String
Dim Cia As String
Dim WSRango As Worksheet
Dim rs As ADODB.Recordset
Dim Cmd As ADODB.Command
Dim Param1 As ADODB.Parameter
Dim Param2 As ADODB.Parameter
Dim Param3 As ADODB.Parameter
On Error GoTo lbError
If Me.Txtchk1.Text = Empty And Me.Txtchk2.Text = Empty Then
MsgBox ("Falta Completar Rango"), vbInformation, "LJimenez"
Exit Sub
End If
chk1 = Me.Txtchk1.Text
chk2 = Me.Txtchk2.Text
If Me.OptionButton1 = True Then
Cia = "1"
Else
Cia = "2"
End If
'************************************************************************************************
'************************************************************************************************
'------Macro Conexion-------
Call CONEXION
'---------------------------
Set Cmd = New ADODB.Command
Set rs = New ADODB.Recordset
With rs
rs.CursorLocation = adUseServer
Cmd.ActiveConnection = cn
Cmd.CommandType = adCmdStoredProc
Cmd.CommandText = "Exec dbo.Llenado_CB ?,?,?" 'exec MattyStore.dbo.InformeVentasGenetal ?,?
Cmd.CommandTimeout = 240 'cuatro minutos
Set Param1 = Cmd.CreateParameter("@chk1", adChar, adParamInput, 10)
Cmd.Parameters.Append Param1 'Anexar
Cmd.Parameters("@chk1").Value = chk1
Set Param2 = Cmd.CreateParameter("@chk2", adChar, adParamInput, 10)
Cmd.Parameters.Append Param2 'Anexar
Cmd.Parameters("@chk2").Value = chk2
Set Param3 = Cmd.CreateParameter("@Cia", adChar, adParamInput, 1)
Cmd.Parameters.Append Param3 'Anexar
Cmd.Parameters("@Cia").Value = Cia
' Set Param1 = Cmd.CreateParameter("@Fecha1", adDate, adParamInput)
' Param1.Value = Fecha1
' Cmd.Parameters.Append Param1
'
' Set Param2 = Cmd.CreateParameter("@Fecha2", adDate, adParamInput)
' Param2.Value = Fecha2
' Cmd.Parameters.Append Param2
'Importante ejeutarlo de este modo
Set rs = Cmd.Execute(, , adCmdText)
'----------------------------------------------------------------------------------------
'If rs.State = adStateClosed Then MsgBox "recordset failed to open"
'Funcion Para crear Hoja nueva
Call CrearHoja("Rango")
'rs.Open
Set WSRango = Worksheets("Rango")
Worksheets("Rango").Activate
With Worksheets("Rango")
WSRango.Range("A6").CopyFromRecordset rs <==== Aqui da el Error
Si pueden ayudarme por favor
Application.ScreenUpdating = False
Dim chk1 As String
Dim chk2 As String
Dim Cia As String
Dim WSRango As Worksheet
Dim rs As ADODB.Recordset
Dim Cmd As ADODB.Command
Dim Param1 As ADODB.Parameter
Dim Param2 As ADODB.Parameter
Dim Param3 As ADODB.Parameter
On Error GoTo lbError
If Me.Txtchk1.Text = Empty And Me.Txtchk2.Text = Empty Then
MsgBox ("Falta Completar Rango"), vbInformation, "LJimenez"
Exit Sub
End If
chk1 = Me.Txtchk1.Text
chk2 = Me.Txtchk2.Text
If Me.OptionButton1 = True Then
Cia = "1"
Else
Cia = "2"
End If
'************************************************************************************************
'************************************************************************************************
'------Macro Conexion-------
Call CONEXION
'---------------------------
Set Cmd = New ADODB.Command
Set rs = New ADODB.Recordset
With rs
rs.CursorLocation = adUseServer
Cmd.ActiveConnection = cn
Cmd.CommandType = adCmdStoredProc
Cmd.CommandText = "Exec dbo.Llenado_CB ?,?,?" 'exec MattyStore.dbo.InformeVentasGenetal ?,?
Cmd.CommandTimeout = 240 'cuatro minutos
Set Param1 = Cmd.CreateParameter("@chk1", adChar, adParamInput, 10)
Cmd.Parameters.Append Param1 'Anexar
Cmd.Parameters("@chk1").Value = chk1
Set Param2 = Cmd.CreateParameter("@chk2", adChar, adParamInput, 10)
Cmd.Parameters.Append Param2 'Anexar
Cmd.Parameters("@chk2").Value = chk2
Set Param3 = Cmd.CreateParameter("@Cia", adChar, adParamInput, 1)
Cmd.Parameters.Append Param3 'Anexar
Cmd.Parameters("@Cia").Value = Cia
' Set Param1 = Cmd.CreateParameter("@Fecha1", adDate, adParamInput)
' Param1.Value = Fecha1
' Cmd.Parameters.Append Param1
'
' Set Param2 = Cmd.CreateParameter("@Fecha2", adDate, adParamInput)
' Param2.Value = Fecha2
' Cmd.Parameters.Append Param2
'Importante ejeutarlo de este modo
Set rs = Cmd.Execute(, , adCmdText)
'----------------------------------------------------------------------------------------
'If rs.State = adStateClosed Then MsgBox "recordset failed to open"
'Funcion Para crear Hoja nueva
Call CrearHoja("Rango")
'rs.Open
Set WSRango = Worksheets("Rango")
Worksheets("Rango").Activate
With Worksheets("Rango")
WSRango.Range("A6").CopyFromRecordset rs <==== Aqui da el Error
Si pueden ayudarme por favor