No me ignoren y ayudenme

04/08/2006 - 18:05 por Ruben | Informe spam
Hola tengo el siguiente codigo en la cual estoy creando 2 hojas de
excel con
sus respectivos encabezados, pero deseo que al momento de que se esta
creando
dichas hojas me salga una barra de progreso o un mensaje que diga
espere un
momento una vez que culmine de crearlas desaparezca... el codigo es:

Private Sub CommandButton1_Click()
Dim Fila As Long, Col As Byte
With Worksheets("Matriz")
If Application.CountIf(.Range("a:a"), Val(textbox1)) Then
Fila = Application.Match(Val(textbox1), .Range("a:a"), 0)


Dim r As Boolean
Dim m As Boolean
Dim hoja As Object
For Each hoja In ActiveWorkbook.Sheets
If hoja.Name = "Reporte Nomina" Then r = True
If hoja.Name = "Reporte Contraloria" Then m = True
Next hoja
If r = True And m = True Then
End If
If r = False Then
Rem UserForm1.Show vbModeless
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = "Reporte Nomina"
Range("A2").Select
ActiveCell.FormulaR1C1 = "PERIODO"
Range("H2").Select
ActiveCell.FormulaR1C1 = "COSTO"
Selection.Font.Bold = True
Range("A4").Select
ActiveCell.FormulaR1C1 = "Cedula"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Compañía"
Range("C4").Select
ActiveCell.FormulaR1C1 = "Empleado"
Range("D4").Select
ActiveCell.FormulaR1C1 = "Clase Nomina"
Range("E4").Select
ActiveCell.FormulaR1C1 = "Cargo"
Range("F4").Select
ActiveCell.FormulaR1C1 = "Dimension Centro Costo"
Range("G4").Select
ActiveCell.FormulaR1C1 = "Total Almuerzos"
Range("H4").Select
ActiveCell.FormulaR1C1 = "Total Meriendas"
Range("I4").Select
ActiveCell.FormulaR1C1 = "Total Comida Dolares"
Range("J4").Select
ActiveCell.FormulaR1C1 = "Descuento 70%"
Range("K4").Select
ActiveCell.FormulaR1C1 = "Descuento 30%"
Range("L4").Select
ActiveCell.FormulaR1C1 = "Diferencias"
Range("A4:L4").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlJustify
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlJustify
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range("A2:D2").Select
Selection.Font.Bold = True
Cells.Select
Cells.EntireColumn.AutoFit
Range("B9").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = _
"&""Arial,Negrita""&14REPORTE DE DESCUENTOS DE
ALIMENTACION"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin Application.InchesToPoints(0.787401575)
.RightMargin Application.InchesToPoints(0.787401575)
.TopMargin Application.InchesToPoints(0.984251969)
.BottomMargin Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
End If
If m = False Then
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = "Reporte Contraloria"
Range("A2").Select
ActiveCell.FormulaR1C1 = "PERIODO"
Range("H2").Select
ActiveCell.FormulaR1C1 = "COSTO"
Selection.Font.Bold = True
Range("A4").Select
ActiveCell.FormulaR1C1 = "Cedula"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Compañía"
Range("C4").Select
ActiveCell.FormulaR1C1 = "Empleado"
Range("D4").Select
ActiveCell.FormulaR1C1 = "Clase Nomina"
Range("E4").Select
ActiveCell.FormulaR1C1 = "Cargo"
Range("F4").Select
ActiveCell.FormulaR1C1 = "Dimension Nomina"
Range("G4").Select
ActiveCell.FormulaR1C1 = "Dimension Centro Costo"
Range("H4").Select
ActiveCell.FormulaR1C1 = "Total Almuerzos"
Range("I4").Select
ActiveCell.FormulaR1C1 = "Total Meriendas"
Range("J4").Select
ActiveCell.FormulaR1C1 = "Total Comida Dolares"
Range("K4").Select
ActiveCell.FormulaR1C1 = "Descuento 70%"
Range("L4").Select
ActiveCell.FormulaR1C1 = "Descuento 30%"
Range("M4").Select
ActiveCell.FormulaR1C1 = "Diferencias"
Range("A4:M4").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlJustify
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlJustify
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range("A2:D2").Select
Selection.Font.Bold = True
Cells.Select
Cells.EntireColumn.AutoFit
Range("B9").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = _
"&""Arial,Negrita""&14REPORTE DE DESCUENTOS DE
ALIMENTACION"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin Application.InchesToPoints(0.787401575)
.RightMargin Application.InchesToPoints(0.787401575)
.TopMargin Application.InchesToPoints(0.984251969)
.BottomMargin Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
Rem Unload UserForm1
End With
End If
If Worksheets("Reporte Nomina").Range("C2").Value Empty
And Worksheets("Reporte Contraloria").Range("C2").Value = Empty Then
Dim periodo As String
periodo = UCase(InputBox("INGRESE LAS FECHAS A
FACTURAR", "Entrada de Datos"))
TextBox23 = periodo
TextBox23.Locked = True
Else
TextBox23 = Worksheets("Reporte
Contraloria").Range("c2").Value
TextBox23.Locked = True


Rem End If
End If


Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
Label7.Visible = True
Label8.Visible = True
Label9.Visible = True
Label10.Visible = True
Label11.Visible = True
Label12.Visible = True
Label13.Visible = True
Label14.Visible = True
Label15.Visible = True
Label16.Visible = True
Label17.Visible = True


TextBox2.Visible = True
TextBox3.Visible = True
TextBox4.Visible = True
TextBox5.Visible = True
TextBox6.Visible = True
TextBox7.Visible = True
TextBox8.Visible = True
TextBox9.Visible = True
TextBox10.Visible = True
TextBox11.Visible = True
TextBox12.Visible = True
TextBox13.Visible = True
TextBox14.Visible = True
TextBox15.Visible = True
TextBox20.Visible = True
TextBox21.Visible = True
TextBox23.Visible = True


Frame1.Visible = True
For Col = 1 To 9
Me.Controls("textbox" & Col) = .Cells(Fila, Col)
Next


Rem If TextBox4.Value = UCase("Fijo") Then
Rem Dim DIA As Integer
Rem DIA = 0
Rem DIA = Val(InputBox("INGRESE EL TOTAL DE DIAS A
DESCONTAR", "Entrada de Datos"))
Rem TextBox9 = DIA
Rem TextBox9.Locked = True
Rem End If
CommandButton2.Visible = True


Else
MsgBox textbox1 & " # CEDULA NO EXISTE EN LA MATRIZ, DEBE DE

CREARLO !!!"
textbox1 = Clear
textbox1.SetFocus
End If
End With
End Sub
Private Sub TextBox_keydown(ByVal KeyCode As MSForms.ReturnInteger,
ByVal
Shift As Integer)
If KeyCode = vbKeyReturn Then MsgBox "Clave erronea"
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[0-9]" Then _
KeyAscii = Asc(UCase(Chr(KeyAscii))) _
Else KeyAscii = &H0
End Sub
Private Sub TextBox10_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If Chr(KeyAscii) Like "[0-9]" Then _
KeyAscii = Asc(UCase(Chr(KeyAscii))) _
Else KeyAscii = &H0
End Sub
Private Sub TextBox10_Change()
almuerzo = Val(TextBox10.Value)
total = almuerzo * valor
total3 = total + total2
TextBox12 = total3
total4 = total3 * 0.7
TextBox13 = total4
total5 = total3 * 0.3
TextBox14 = total5
TextBox15 = total4 + total5 - total3
End Sub
Private Sub TextBox11_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If Chr(KeyAscii) Like "[0-9]" Then _
KeyAscii = Asc(UCase(Chr(KeyAscii))) _
Else KeyAscii = &H0
End Sub
Private Sub TextBox11_Change()
merienda = Val(TextBox11.Value)
total2 = merienda * valor
total3 = total + total2
TextBox12 = total3
total4 = total3 * 0.7
TextBox13 = total4
total5 = total3 * 0.3
TextBox14 = total5
TextBox15 = total4 + total5 - total3
End Sub
 

Leer las respuestas

#1 Héctor Miguel
05/08/2006 - 08:11 | Informe spam
hola, Ruben !

... codigo... creando 2 hojas... con sus respectivos encabezados
... deseo que... salga una barra de progreso o un mensaje que diga espere un momento
una vez que culmine de crearlas desaparezca... el codigo es: [...]



-> 'actualizar' una progressbar requiere 'decirle' al codigo en que momento 'avanza' el indicador

-> en tanto 'encuentras' [en el codigo que empleas] cuel/es seria/n el/los momento/s 'adecuaado/s'...
1) podrias usar [p.e.] la barra de estado de la aplicacion [por un modulo de clase]...
en la pagina de John Walkenbach, puedes descargar un ejemplo en:
http://j-walk.com/ss/excel/files/progressbar.exe
2) o por otro tipo de objetos [formularios], prueba con los siguientes enlaces:
en la pagina de John Walkenbach, descargas un ejemplo en:
http://j-walk.com/ss/excel/files/progind.exe
en la pagina de Ole P. Erlandsen, descargas [dos] ejemplos en
a) http://www.erlandsendata.no/downloa...ontrol.zip
b) http://www.erlandsendata.no/downloa...amples.zip
otro ejemplo de XL-Logic en: http://www.xl-logic.com/xl_files/vb...e_wait.zip
otro mas en la pagina de Chip Pearson: http://www.cpearson.com/excel/Progress.htm

Microsoft KB: XL Como Mostrar un Barra Progreso con un Formulario de Usuario
[basado en la tecnica de John Walkenbach] http://support.microsoft.com/kb/211736/

saludos,
hector.

Preguntas similares