Olá amigos,

abri esse tópico porque ainda não vi ninguem aki falando sobre isso. Estou com um problema no meu relatório pois ele não estava atualizando, ja tinha feito de tudo que era passado pra mim nesse forum e msmo assim não adiantava nada. Pois bem, acabei descobrindo q o problema era exatamente no tempo de execução do meu programa, ou seja, ele estava sendo executado tão rápido q não tinha como o CR ter tempo para atualizar o meu relatório, tanto q através da função breakpoint no VB (aquela q vcv usa pra parar numa linha q acha q ta errada) eu pude perceber q ele finalmente atualizava pois o tempo de execução do programa era mais retardado e possibilitava o CR de atualizar os campos do relatorio.

 

Pois bem meus amigos minha pergunta é, o posso fazer para q o meu relatório seja atualizado ou, existe alguma maneira de fazer com q meu programa retarde um pouco seu tempo de execução para q o CR atualize os campos...?

 

Obrigado!!!

 

Ewerton Moreira.

Private Sub CmdImprimir_Click()

 Dim RefAux, CorAux, TamAux, Ref(), Cor(), Tam(), R(), C(), T(), Linha(), Cor1, Cor2 As String
 Dim Contador, f, i, j, LinhaAux, Espaco(1 To 5) As Integer
 Dim Registro As Double

 'Se não for escolida nenhuma loja
 If LojaEtq = "" Then
  MsgBox "Selecione uma Loja!", vbOKOnly + vbExclamation, "Imprime Etiquetas"
  Exit Sub
 End If
 
 Cor1 = "Cor:"
 Cor2 = "Tam:"
 
 Contador = 0
 
 Espaco(1) = 0
 Espaco(2) = 1
 Espaco(3) = 1
 Espaco(4) = 1
 Espaco(5) = 1
 
  'Abre TB_DADOS
 DtTB_DADOS.DatabaseName = App.Path & "Etiquetas.mdb"
 DtTB_DADOS.RecordSource = "TB_DADOS"
 DtTB_DADOS.Refresh

 'Apaga se tem Algo na tabela
 If Not DtTB_DADOS.Recordset.EOF And Not DtTB_DADOS.Recordset.BOF Then
  DtTB_DADOS.Database.Execute "DELETE * FROM TB_DADOS"
 End If
 
 'Grava na TB_DADOS
 For i = 0 To 9
  If TxtRef(i).Text <> "" Then
   DtTB_DADOS.Recordset.AddNew
   DtTB_DADOS.Recordset.Fields("REF") = LojaEtq & TxtRef(i).Text
   DtTB_DADOS.Recordset.Fields("COR") = TxtCor(i).Text
   DtTB_DADOS.Recordset.Fields("TAM") = TxtTam(i).Text
   DtTB_DADOS.Recordset.Update
  End If
 Next
 
 'PASSAR PARA TB_ETQ NO FORMATO NECESSARIO
 If DtTB_DADOS.Recordset.EOF And DtTB_DADOS.Recordset.BOF Then
  MsgBox "O arquivo está vazio!", vbOKOnly + vbExclamation, "Imprime Etiquetas"
  Exit Sub
 End If
 
 DtTB_DADOS.Refresh
 DtTB_DADOS.Recordset.MoveMin

 While Not DtTB_DADOS.Recordset.EOF
  RefAux = DtTB_DADOS.Recordset.Fields("REF")
  CorAux = DtTB_DADOS.Recordset.Fields("COR")
  TamAux = DtTB_DADOS.Recordset.Fields("TAM")

  Contador = Contador + 1
  ReDim Preserve Ref(1 To Contador)
  ReDim Preserve Cor(1 To Contador)
  ReDim Preserve Tam(1 To Contador)
  Ref(Contador) = RefAux
  Cor(Contador) = CorAux
  Tam(Contador) = TamAux
 
  DtTB_DADOS.Recordset.MoveNext

 Wend

 DtTB_DADOS.Recordset.Close

 If Contador = 0 Then Exit Sub
 
 'Passa Ref(), Cor() e Tam() para R(), C() e T()
 ReDim Preserve R(1 To Contador)
 ReDim Preserve C(1 To Contador)
 ReDim Preserve T(1 To Contador)

 For f = 1 To Contador
  R(f) = Ref(f)
  If Len(R(f)) < 10 Then
   R(f) = R(f) + Space(10 - Len(R(f)))
  End If
  C(f) = Cor1 + Cor(f)
  If Len(C(f)) < 10 Then
   C(f) = C(f) + Space(10 - Len(C(f)))
  End If
  T(f) = Cor2 + Tam(f)
  If Len(T(f)) < 10 Then
   T(f) = T(f) + Space(10 - Len(T(f)))
  End If
 Next

 LinhaAux = 0
 Registro = 1
 
 'Monta Linhas
 For f = 1 To Int(Contador / 5) + 1
  If (Contador - Registro) >= 5 Then
   LinhaAux = LinhaAux + 3
    ReDim Preserve Linha(1 To LinhaAux)
     For i = 1 To 5
      Linha(LinhaAux - 2) = Linha(LinhaAux - 2) & Space(Espaco(i)) & R(Registro)
      Linha(LinhaAux - 1) = Linha(LinhaAux - 1) & Space(Espaco(i)) & C(Registro)
      Linha(LinhaAux) = Linha(LinhaAux) & Space(Espaco(i)) & T(Registro)
      Registro = Registro + 1
     Next
  Else
   LinhaAux = LinhaAux + 3
   ReDim Preserve Linha(1 To LinhaAux)
   For i = 1 To (Contador - Registro) + 1
    Linha(LinhaAux - 2) = Linha(LinhaAux - 2) & Space(Espaco(i)) & R(Registro)
    Linha(LinhaAux - 1) = Linha(LinhaAux - 1) & Space(Espaco(i)) & C(Registro)
    Linha(LinhaAux) = Linha(LinhaAux) & Space(Espaco(i)) & T(Registro)
    Registro = Registro + 1
   Next
  End If
 Next
 
 'Gravar no TB_ETQ
 DtTB_ETQ.DatabaseName = App.Path & "Etiquetas.mdb"
 DtTB_ETQ.RecordSource = "TB_ETQ"
 DtTB_ETQ.Refresh
 
 If Not DtTB_ETQ.Recordset.EOF And Not DtTB_ETQ.Recordset.BOF Then
  DtTB_ETQ.Database.Execute "DELETE * FROM TB_ETQ"
 End If

 For f = 1 To LinhaAux Step 3
  DtTB_ETQ.Recordset.AddNew
  DtTB_ETQ.Recordset.Fields("LINHA1") = Linha(f)
  DtTB_ETQ.Recordset.Fields("LINHA2") = Linha(f + 1)
  DtTB_ETQ.Recordset.Fields("LINHA3") = Linha(f + 2)
  DtTB_ETQ.Recordset.Update
 Next
 
 DtTB_ETQ.Refresh
 DtTB_ETQ.Recordset.Close

 'Chama Crystal Reports
 RptETQ.Reset
 RptETQ.Destination = 0
 RptETQ.ReportFileName = App.Path & "Etiquetas.RPT"
 RptETQ.DataFiles(0) = App.Path & "Etiquetas.mdb"
 RptETQ.DiscardSavedData = True
 RptETQ.WindowTitle = "Impressão de Etiquetas"
 RptETQ.WindowTop = 0: RptETQ.WindowLeft = 0
 RptETQ.WindowHeight = Screen.Height / 15.4
 RptETQ.WindowWidth = Screen.Width / 15
 RptETQ.Action = 1
 
End Sub

Eu já tive este problema uma e vez e resolvi colocondo um begin transaction e um commit, antes de chamar o report. Mas foi com bd Sqlserver.

 

 

mas no vb tem como fazer isso? o meu banco é access meu vb é o 6 e to usando conexão DAO 3.6.