Ir para o conteúdo
  • Revista PROGRAMAR: Já está disponível a edição #60 da revista programar. Faz já o download aqui!

sapuser

Barra de Progresso

Mensagens Recomendadas

sapuser

Bom dia,

gostaria de saber como se pode colocar a barra de progresso a funcionar num form emquanto o SQL executa um comando.

por exemplo uma listagem para exel...

ir mostrando o progresso da leitura dos dados com percentagem.

já tentei vários exemplos mas não consegui encontrar nenhum codigo que me elucidasse.

se pudessem ajudar-me com um codigo de exemplo...

desde já o meu muito obrigado.

Jorge Miguel Carvalho

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
FDomingos

Podes carregar tudo para uma datatable, defines como tamanho da barra o número de registos da datatable e à medida que vais exportando os registos incrementas a barra em 1 por exemplo.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
sapuser

estou a usar o seguinte codigo, neste caso é uma listagem para excel, mas ele exporta primeiro para excel e só depois começa a fazer o incremento na barra.

o que estou a fazer de mal?

desde já o meu muito obrigado,

Private Sub btnExecutar_Click(sender As Object, e As EventArgs) Handles btnExecutar.Click
 StrQuery = "SELECT * FROM TDU_ZX"
 StrWhere = " WHERE 1 = 1 "
 If txtNumero1.Value <> 0 And txtNumero2.Value = 0 Then
	 StrWhere = StrWhere & " AND NUMERO = '" & txtNumero1.Value & "'"
 ElseIf txtNumero1.Value <> 0 And txtNumero2.Value <> 0 Then
	 StrWhere = StrWhere & " AND NUMERO >= '" & txtNumero1.Value & "'" &
							 " AND NUMERO <= '" & txtNumero2.Value & "'"
 ElseIf txtNumero1.Value = 0 And txtNumero2.Value <> 0 Then
	 StrWhere = StrWhere & " AND NUMERO <= '" & txtNumero2.Value & "'"
 End If
 If txtPublisher.Text <> "" Then
	 StrWhere = StrWhere & " AND PUBLISHER LIKE '" & Replace(txtPublisher.Text, "*", "%") & "'"
 End If
 If txtAno.Text <> "" Then
	 StrWhere = StrWhere & " AND YEAR = '" & txtAno.Text & "'"
 End If
 StrQuery = StrQuery & StrWhere & " ORDER BY PUBLISHER ASC, TITLE ASC "
 Dim con1 As New SqlConnection("Data Source=(LocalDB)\MSSQLLocalDB;AttachDbFilename=c:\ZX\ZX.mdf;Integrated Security=True;Connect Timeout=30")
 Dim COM1 As New SqlCommand(StrQuery, con1)
 Dim PUB As SqlDataReader
 con1.Open()
 PUB = COM1.ExecuteReader
 Timer1.Start()
 Do While PUB.Read
	 ProgressBar1.Maximum += 1
 Loop
 con1.Close()
 con1 = Nothing
 COM1 = Nothing
 Lista_Excel(StrQuery)
End Sub



Private Sub Lista_Excel(StrQUERY As String)
 Dim xlApp As New Microsoft.Office.Interop.Excel.Application
 Dim xlBook As Microsoft.Office.Interop.Excel.Workbook = Nothing
 Dim xlSheet As Microsoft.Office.Interop.Excel.Worksheet = Nothing
 Dim LE As Integer = 0
 Dim con As New SqlConnection("Data Source=(LocalDB)\MSSQLLocalDB;AttachDbFilename=c:\ZX\ZX.mdf;Integrated Security=True;Connect Timeout=30")
 Try
	 xlBook = xlApp.Workbooks.Add
	 xlSheet = xlApp.Worksheets(1)
	 LE = 1
	 With xlSheet.Range("A" & LE & "" & LE)
		 .Font.Name = "Calibri"
		 .Font.Size = 9
		 .Interior.ColorIndex = 15
		 .Font.Bold = True
		 .HorizontalAlignment = -4108
	 End With
	 xlSheet.Range("A" & LE).Value = "NUMERO"
	 xlSheet.Range("B" & LE).Value = "				 NOME DO JOGO			 "
	 xlSheet.Range("C" & LE).Value = " ANO "
	 xlSheet.Range("D" & LE).Value = "				 FABRICANTE				 "
	 LE = 2
	 Dim COM As New SqlCommand(StrQUERY, con)
	 Dim PUB As SqlDataReader
	 con.Open()
	 PUB = COM.ExecuteReader

	 Do While PUB.Read
		 xlSheet.Range("A" & LE & "" & LE).Font.Name = "Calibri"
		 xlSheet.Range("A" & LE & "" & LE).Font.Size = 9
		 xlSheet.Range("A" & LE).Value = PUB("NUMERO")
		 xlSheet.Range("A" & LE).HorizontalAlignment = -4108
		 xlSheet.Range("B" & LE).Value = PUB("TITLE")
		 xlSheet.Range("B" & LE).HorizontalAlignment = -4131
		 xlSheet.Range("C" & LE).Value = PUB("YEAR")
		 xlSheet.Range("C" & LE).HorizontalAlignment = -4108
		 xlSheet.Range("D" & LE).Value = PUB("PUBLISHER")
		 xlSheet.Range("D" & LE).HorizontalAlignment = -4131
		 LE += 1
	 Loop

	 con.Close()
	 con = Nothing
	 COM = Nothing
	 PUB.Close()
	 LE = LE - 1
	 xlSheet.Cells.EntireColumn.AutoFit()
	 xlSheet.Range("A1" & "" & LE).Borders.LineStyle = -4118
	 xlSheet.Range("A2").Select()
	 xlSheet.Application.Activewindow.FreezePanes = True
	 With xlSheet.PageSetup
		 .CenterFooter = "Pag.&P/&N"
		 .Orientation = XlPageOrientation.xlPortrait
		 .Zoom = False
		 .FitToPagesWide = 1
		 .FitToPagesTall = False
		 .PrintTitleRows = "$A$1:$D$1"
	 End With
	 xlApp.Visible = True
	 xlApp = Nothing
	 xlBook = Nothing
	 xlSheet = Nothing
 Catch ex As Exception
	 MsgBox(ex.Message)
	 xlApp.Visible = False
	 xlApp = Nothing
	 xlBook = Nothing
	 xlSheet = Nothing
 End Try
End Sub



Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
 ProgressBar1.Increment(1)
 If ProgressBar1.Value = ProgressBar1.Maximum Then
	 Timer1.Stop()
 End If
End Sub

Editado por sapuser

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
sapuser

bom dia,

continuo a não conseguir por a barra a funcionar.

ela funciona com este codigo, mas só executa depois de aparecer a listagem em excel e o que pretendia era exactamente ao contrario, ou seja a barra mostrar o progresso de leitura de dados e só depois de chegar ao fim aparecer a listagem em excel no ecran.

desde já o meu muito obrigado,

Jorge Miguel Carvalho

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
FDomingos

Em vez de usares ligações persistentes, usa uma DataTable, define o tamanho da progressbar com o número de registos desta e vai incrementando a barra a cada registo feito.

Pelo que vejo, não precisares de usar o Timer.

Não testei, mas parece que é mais ou menos isto que queres.

Private Sub btnExecutar_Click(sender As Object, e As EventArgs) Handles btnExecutar.Click
StrQuery = "SELECT * FROM TDU_ZX"
StrWhere = " WHERE 1 = 1 "
If txtNumero1.Value <> 0 And txtNumero2.Value = 0 Then
StrWhere = StrWhere & " AND NUMERO = '" & txtNumero1.Value & "'"
ElseIf txtNumero1.Value <> 0 And txtNumero2.Value <> 0 Then
StrWhere = StrWhere & " AND NUMERO >= '" & txtNumero1.Value & "'" &
" AND NUMERO <= '" & txtNumero2.Value & "'"
ElseIf txtNumero1.Value = 0 And txtNumero2.Value <> 0 Then
StrWhere = StrWhere & " AND NUMERO <= '" & txtNumero2.Value & "'"
End If
If txtPublisher.Text <> "" Then
StrWhere = StrWhere & " AND PUBLISHER LIKE '" & Replace(txtPublisher.Text, "*", "%") & "'"
End If
If txtAno.Text <> "" Then
StrWhere = StrWhere & " AND YEAR = '" & txtAno.Text & "'"
End If
StrQuery = StrQuery & StrWhere & " ORDER BY PUBLISHER ASC, TITLE ASC "
Dim con1 As New SqlConnection("Data Source=(LocalDB)\MSSQLLocalDB;AttachDbFilename=c:\ZX\ZX.mdf;Integrated Security=True;Connect Timeout=30")
Dim COM1 As New SqlCommand(StrQuery, con1)
Dim PUB As SqlDataReader
con1.Open()
PUB = COM1.ExecuteReader


con1.Close()
con1 = Nothing
COM1 = Nothing
Lista_Excel(StrQuery)
End Sub



Private Sub Lista_Excel(StrQUERY As String)
Dim xlApp As New Microsoft.Office.Interop.Excel.Application
Dim xlBook As Microsoft.Office.Interop.Excel.Workbook = Nothing
Dim xlSheet As Microsoft.Office.Interop.Excel.Worksheet = Nothing
Dim LE As Integer = 0
Dim con As New SqlConnection("Data Source=(LocalDB)\MSSQLLocalDB;AttachDbFilename=c:\ZX\ZX.mdf;Integrated Security=True;Connect Timeout=30")
Try
xlBook = xlApp.Workbooks.Add
xlSheet = xlApp.Worksheets(1)
LE = 1
With xlSheet.Range("A" & LE & "" & LE)
.Font.Name = "Calibri"
.Font.Size = 9
.Interior.ColorIndex = 15
.Font.Bold = True
.HorizontalAlignment = -4108
End With
xlSheet.Range("A" & LE).Value = "NUMERO"
xlSheet.Range("B" & LE).Value = " NOME DO JOGO "
xlSheet.Range("C" & LE).Value = " ANO "
xlSheet.Range("D" & LE).Value = " FABRICANTE "
LE = 2
Dim COM As New SqlCommand(StrQUERY, con)

'Declaração da DataTable e do SqlDataAdapter
Dim dt As New DataTable
Dim da As New SqlDataAdapter(COM)

da.Fill(dt)

'Define o tamanho máximo da ProgressBar
ProgressBar1.Maximum = dt.Rows.Count


For Each PUB As DataRow In dt.Rows
xlSheet.Range("A" & LE & "" & LE).Font.Name = "Calibri"
xlSheet.Range("A" & LE & "" & LE).Font.Size = 9
xlSheet.Range("A" & LE).Value = PUB("NUMERO")
xlSheet.Range("A" & LE).HorizontalAlignment = -4108
xlSheet.Range("B" & LE).Value = PUB("TITLE")
xlSheet.Range("B" & LE).HorizontalAlignment = -4131
xlSheet.Range("C" & LE).Value = PUB("YEAR")
xlSheet.Range("C" & LE).HorizontalAlignment = -4108
xlSheet.Range("D" & LE).Value = PUB("PUBLISHER")
xlSheet.Range("D" & LE).HorizontalAlignment = -4131
LE += 1
ProgressBar1.Increment(1)
Next


LE = LE - 1
xlSheet.Cells.EntireColumn.AutoFit()
xlSheet.Range("A1" & "" & LE).Borders.LineStyle = -4118
xlSheet.Range("A2").Select()
xlSheet.Application.Activewindow.FreezePanes = True
With xlSheet.PageSetup
.CenterFooter = "Pag.&P/&N"
.Orientation = XlPageOrientation.xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintTitleRows = "$A$1:$D$1"
End With
xlApp.Visible = True
xlApp = Nothing
xlBook = Nothing
xlSheet = Nothing
Catch ex As Exception
MsgBox(ex.Message)
xlApp.Visible = False
xlApp = Nothing
xlBook = Nothing
xlSheet = Nothing
End Try
End Sub

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
sapuser

boas,

tal como está dá erro.

não me deixa declarar a datatable.

dá-me erro com o comando:

Dim dt as new DataTable (diz que não posso usar o argumento "new")

mesmo que tire o "new" e Coloque:

Dim dt as DataTable (assim já deixa declarar)

mas depois dá erro no comando:

da.fill(dt)

dá erro no "fill"

já tentei de varias maneiras e não consigo dar com os erros....

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
sapuser

já consegui descobrir o erro.

estava a fazer o:

imports microsoft.office.interop.excel

e tirando esta importação já funcionou.

o meu muito obrigado.

deixo aqui o codigo para quem estiver interessado (está a funcionar com a devida apresentação da % de progresso):

Private Sub btnExecutar_Click(sender As Object, e As EventArgs) Handles btnExecutar.Click
    StrQuery = "SELECT * FROM TDU_ZX"
    StrWhere = " WHERE 1 = 1 "
    If txtNumero1.Value <> 0 And txtNumero2.Value = 0 Then
	    StrWhere = StrWhere & " AND NUMERO = '" & txtNumero1.Value & "'"
    ElseIf txtNumero1.Value <> 0 And txtNumero2.Value <> 0 Then
	    StrWhere = StrWhere & " AND NUMERO >= '" & txtNumero1.Value & "'" &
							  " AND NUMERO <= '" & txtNumero2.Value & "'"
    ElseIf txtNumero1.Value = 0 And txtNumero2.Value <> 0 Then
	    StrWhere = StrWhere & " AND NUMERO <= '" & txtNumero2.Value & "'"
    End If
    If txtPublisher.Text <> "" Then
	    StrWhere = StrWhere & " AND PUBLISHER LIKE '" & Replace(txtPublisher.Text, "*", "%") & "'"
    End If
    If txtAno.Text <> "" Then
	    StrWhere = StrWhere & " AND YEAR = '" & txtAno.Text & "'"
    End If
    If RdNumero.Checked = True Then
	    StrQuery = StrQuery & StrWhere & " ORDER BY NUMERO ASC , PUBLISHER ASC , TITLE ASC"
    ElseIf rdNome.Checked = True Then
	    StrQuery = StrQuery & StrWhere & " ORDER BY TITLE ASC , PUBLISHER ASC , NUMERO ASC"
    ElseIf rdFabricante.Checked = True Then
	    StrQuery = StrQuery & StrWhere & " ORDER BY PUBLISHER ASC , TITLE ASC, NUMERO ASC"
    ElseIf rdAno.Checked = True Then
	    StrQuery = StrQuery & StrWhere & " ORDER BY YEAR ASC, PUBLISHER ASC, TITLE ASC "
    End If

    Lista_Excel(StrQuery)
   End Sub
   Private Sub Lista_Excel(StrQUERY As String)
    Dim xlApp As New Microsoft.Office.Interop.Excel.Application
    Dim xlBook As Microsoft.Office.Interop.Excel.Workbook = Nothing
    Dim xlSheet As Microsoft.Office.Interop.Excel.Worksheet = Nothing
    Dim LE As Integer = 0
    Dim con As New SqlConnection("Data Source=(LocalDB)\MSSQLLocalDB;AttachDbFilename=c:\ZX\ZX.mdf;Integrated Security=True;Connect Timeout=30")
    Dim con1 As New SqlConnection("Data Source=(LocalDB)\MSSQLLocalDB;AttachDbFilename=c:\ZX\ZX.mdf;Integrated Security=True;Connect Timeout=30")
    Try
	    xlBook = xlApp.Workbooks.Add
	    xlSheet = xlApp.Worksheets(1)
	    LE = 1
	    With xlSheet.Range("A" & LE & "" & LE)
		    .Font.Name = "Calibri"
		    .Font.Size = 9
		    .Interior.ColorIndex = 15
		    .Font.Bold = True
		    .HorizontalAlignment = -4108
	    End With
	    xlSheet.Range("A" & LE).Value = "NUMERO"
	    xlSheet.Range("B" & LE).Value = "				 NOME   DO   JOGO			   "
	    xlSheet.Range("C" & LE).Value = " ANO "
	    xlSheet.Range("D" & LE).Value = "				   FABRICANTE				   "
	    LE = 2
	    Dim COM As New SqlCommand(StrQUERY, con)
	    Dim Com1 As New SqlCommand(StrQUERY, con1)
	    Dim PUB As SqlDataReader
	    con.Open()
	    con1.Open()
	    PUB = COM.ExecuteReader
	    Dim dt As New DataTable
	    Dim da As New SqlDataAdapter(Com1)
	    da.Fill(dt)
	    ProgressBar1.Maximum = dt.Rows.Count

	    Do While PUB.Read
		    xlSheet.Range("A" & LE & "" & LE).Font.Name = "Calibri"
		    xlSheet.Range("A" & LE & "" & LE).Font.Size = 9
		    xlSheet.Range("A" & LE).Value = PUB("NUMERO")
		    xlSheet.Range("A" & LE).HorizontalAlignment = -4108
		    xlSheet.Range("B" & LE).Value = PUB("TITLE")
		    xlSheet.Range("B" & LE).HorizontalAlignment = -4131
		    xlSheet.Range("C" & LE).Value = PUB("YEAR")
		    xlSheet.Range("C" & LE).HorizontalAlignment = -4108
		    xlSheet.Range("D" & LE).Value = PUB("PUBLISHER")
		    xlSheet.Range("D" & LE).HorizontalAlignment = -4131
		    LE += 1
		    ProgressBar1.Increment(1)
		    Dim Perc As Double
		    Perc = Math.Round((ProgressBar1.Value * 100) / ProgressBar1.Maximum, 0)
		    Label1.Text = Perc
	    Loop

	    con.Close()
	    con1.close
	    con = Nothing
	    con1 = Nothing
	    COM = Nothing
	    Com1 = Nothing
	    PUB.Close()
	    LE = LE - 1
	    xlSheet.Cells.EntireColumn.AutoFit()
	    xlSheet.Range("A1" & "" & LE).Borders.LineStyle = -4118
	    xlSheet.Range("A2").Select()
	    xlSheet.Application.Activewindow.FreezePanes = True
	    With xlSheet.PageSetup
		    .CenterFooter = "Pag.&P/&N"
		    .Orientation = Microsoft.Office.Interop.Excel.XlPageOrientation.xlPortrait
		    .Zoom = False
		    .FitToPagesWide = 1
		    .FitToPagesTall = False
		    .PrintTitleRows = "$A$1:$D$1"
	    End With
	    xlApp.Visible = True
	    xlApp = Nothing
	    xlBook = Nothing
	    xlSheet = Nothing
	    ProgressBar1.Value = 0
	    Label1.Text = 0
    Catch ex As Exception
	    MsgBox(ex.Message)
	    xlApp.Visible = False
	    xlApp = Nothing
	    xlBook = Nothing
	    xlSheet = Nothing
    End Try
   End Sub

Mas agora se ficou a funcionar em termos de contagem de registos, como faço para fazer uma barra de progresso funcionar em função do tempo de execução de um comando. deixo aqui este exemplo, neste caso ao sair ele faz o SHRINK DATABASE.

Queria colocar tambem uma barra de progresso consoante o tempo que ele demora a executar o comando.

muito obrigado,

Private Sub btnSair_Click(sender As Object, e As EventArgs) Handles btnSair.Click
    Try
	    Dim Con As New SqlConnection("Data Source=(LocalDB)\MSSQLLocalDB;AttachDbFilename=C:\ZX\ZX.mdf;Integrated Security=True;Connect Timeout=30")
	    StrQuery = "DBCC SHRINKDATABASE(N'c:\ZX\ZX.mdf')"
	    Con.Open()
	    SQLCmd = New SqlCommand(StrQuery, Con)
	    SQLCmd.CommandTimeout = 0
	    SQLCmd.ExecuteNonQuery()
	    Con.Close()
	    Con = Nothing
    Catch ex As Exception
	    MsgBox(Err.Description, Me.Text)
    End Try
    Close()
   End Sub

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!

Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.

Entrar Agora

×

Aviso Sobre Cookies

Ao usar este site você aceita os nossos Termos de Uso e Política de Privacidade. Este site usa cookies para disponibilizar funcionalidades personalizadas. Para mais informações visite esta página.