Tema: Retrasar una tarea en una macro
Ver Mensaje Individual
  #1 (permalink)  
Antiguo 26/07/2010, 04:17
jesusjj
 
Fecha de Ingreso: noviembre-2007
Mensajes: 154
Antigüedad: 16 años, 4 meses
Puntos: 2
Pregunta Retrasar una tarea en una macro
Buenos días:

Les comento. Estoy montando una macro en excel (2003), que obtiene una serie de datos de SQL SERVER. Tras obetenerlos, los copia y hace pegado especial de valores y formatos en un nuevo libro.

Estoy teniendo un problema cuando ejecuto la macro sin depurarla, ya que me pega en el nuevo libro:
"DatosExternos_2: Importando datos..."

Es decir, llega al paso de copiado/pegado antes de finalizar la obtención de datos.

El código es el siguiente:
Código vb: 
Ver original
  1. '2 - OPERACIONES BBDD
  2.     strConn = "ODBC;DSN=XXXXXXX;Description=XXXXXX;UID=XXXXXXXX;PWD=XXXXXXXX"
  3.     
  4.     sqlString = "SELECT " & _
  5.         "substring(FechaSIE,5,2) [MES], " & _
  6.         "UnidadAdmision [ADMISION], " & _
  7.         "PRODUCTO, " & _
  8.         "sum(Numero) [ENVIOS] " & _
  9.     "FROM tSIE_PRODUCTOS_CONCILIACION " & _
  10.     "WHERE " & _
  11.         "year(FechaSIE) = '" & Anio & "' " & _
  12.         "and month(FechaSIE) = '" & MesAnterior & "' " & _
  13.     "GROUP BY FechaSIE, UnidadAdmision, Producto  order by FechaSIE, UnidadAdmision, Producto "
  14.     
  15.         
  16.     Range("F2").Select
  17.         
  18.         
  19.     If Range("F2") = "" Then
  20.         With ActiveSheet.QueryTables.Add(Connection:=strConn, Destination:=Range("A1"), Sql:=sqlString)
  21.             .Refresh
  22.         End With
  23.             
  24.     Else
  25.         ActiveSheet.Select
  26.         ActiveSheet.Cells.ClearContents
  27.         
  28.         With ActiveSheet.QueryTables.Add(Connection:=strConn, Destination:=Range("A1"), Sql:=sqlString)
  29.             .Refresh
  30.         End With
  31.             
  32.     End If
  33.             
  34.     '***************************************************************************************
  35.         
  36. '3 - CÁLCULO DE ENVÍOS TOTALES
  37.     'con este parametro (xlDown) buscará la última celda con valor hacia abajo
  38.     celda = Range("D1").End(xlDown).Address
  39.         
  40.     Range("F1").Select
  41.     Selection.Font.Bold = True
  42.     Range("F1").Value = "TOTAL ENVÍOS"
  43.           
  44.     Range("F2").Select
  45.     Application.CutCopyMode = False
  46.     ActiveCell.Formula = "=SUM($D$2: " & celda & ")"
  47.     
  48.     '***************************************************************************************
  49.     
  50. '4 - COPIA DE DOCUMENTO
  51.     ruta = ThisWorkbook.Path & "\"
  52.     NombreFichero = Anio & MesAnterior & "_" & NombreMes & "_Conc_XX_XXX.xls"
  53.     Destino = ruta & NombreFichero
  54.     
  55.     'validamos si existe el libro
  56.         
  57.     Set fso = CreateObject("Scripting.FileSystemObject")
  58.     With fso
  59.         If .FileExists(Destino) Then
  60.             With .GetFile(Destino)
  61.                 'se abre el libro y borra el contenido
  62.                 Workbooks.Open Filename:=Destino
  63.                 Workbooks(2).Activate
  64.                 Workbooks(2).Sheets(1).Activate
  65.                 ActiveSheet.Cells.ClearContents
  66.             End With
  67.         Else
  68.             'crea el libro
  69.             Set wrkNuevo = Workbooks.Add
  70.             
  71.             'crea un libro nuevo con una hoja
  72.             Application.SheetsInNewWorkbook = 1
  73.             ActiveWorkbook.SaveAs Filename:=Destino, FileFormat:= _
  74.             xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
  75.             , CreateBackup:=False
  76.         End If
  77.     End With
  78.               
  79.     'copiamos y pegamos el contenido del libro 1
  80.             
  81.     Workbooks(1).Sheets(1).Activate
  82.     Cells.Select
  83.     Selection.Copy
  84.     Workbooks(2).Sheets(1).Activate
  85.     Cells.Select
  86.     Selection.PasteSpecial Paste:=xlPasteValues
  87.     Selection.PasteSpecial Paste:=xlPasteFormats
  88.     Application.CutCopyMode = False
  89.         
  90.     'cambiamos el nombre de la pestaña al libro nuevo
  91.     Application.DisplayAlerts = False
  92.     ActiveSheet.Name = MesAnterior & " - " & NombreMes
  93.     
  94.     'salvamos el libro
  95.     ActiveWorkbook.Save

A ver si alguien me puede orientar cómo hacer que se 'espere' el copiado a que finalice la consulta.

Muchas gracias.

Saludos.