Hola a todos quisiera ver si es que me pueden ayudar con esto tengo, un formulario con varios text, 3 botones de comando y un msflexgrid todo va bien el problema es cuando le doy al tercer command3 que es para exportar los datos a un archivo de texto
mi primer regitro bien todo normal pero despues que exporto y quiero hacer otro registro se borran los encabezados del msflexgrid y empieza a llenar los datos dese la 3 fila.
Espero que me puedan ayudar de ante mano les agradezco por su tiempo.
Este es el codigo
Private Sub AddGrid(MSFlexGrid1 As MSFlexGrid, Fila As Single, columna As Single, Texto As String)
' Comprobamos si la fila existe, si no la añadimos.
If MSFlexGrid1.Rows - 1 < Fila Then MSFlexGrid1.Rows = Fila + 1
' Comprobamos si la columna existe, si no la añadimos.
If MSFlexGrid1.Cols - 1 < columna Then Grid.Cols = columna + 1
' Pasamos el dato al Grid
MSFlexGrid1.TextMatrix(Fila, columna) = Texto
End Sub
'''--------Star comando agregar datos de los text al msflexgrid--------r''
Private Sub Command1_Click()
If Len(Text9) <> 11 Then
MsgBox "Número de RUC Incorrecto", vbInformation, "Mensaje"
Exit Sub
End If
If Text2 = Empty Then
MsgBox "Ingrese Número de Cuenta de Proveedor", vbInformation, "Mensaje"
Exit Sub
End If
If Text10 = Empty Then
MsgBox "Ingrese Tipo de Bien o Servicio", vbInformation, "Mensaje"
Exit Sub
End If
If Text11 = Empty Then
MsgBox "Ingrese Tipo de Operación", vbInformation, "Mensaje"
Exit Sub
End If
If Text12 = Empty Then
MsgBox "Ingrese Importe", vbInformation, "Mensaje"
Exit Sub
End If
If Val(Text12) = 0 Then
MsgBox "Ingrese Importe", vbInformation, "Mensaje"
Exit Sub
End If
Static Fila As Single
Dim monto As String
monto = Val(Text12) & "." & Val(Text13)
Fila = Fila + 1
AddGrid MSFlexGrid1, Fila, 1, Text9
AddGrid MSFlexGrid1, Fila, 2, Text3 & Text4
AddGrid MSFlexGrid1, Fila, 3, "000" & Text10
AddGrid MSFlexGrid1, Fila, 4, Text2
AddGrid MSFlexGrid1, Fila, 5, monto
AddGrid MSFlexGrid1, Fila, 6, Text11
tot = tot + monto
Text8 = Format(tot, "###,###,###,##0.00")
Text9 = ""
Text10 = ""
Text11 = ""
Text12 = ""
Text13 = ""
Text9.SetFocus
End Sub
'''--------start comando eliminar--------r''
Private Sub Command2_Click()
Pos = RegActual
If MsgBox(" Está seguro de eliminar el contacto ? ", vbYesNo) = vbNo Then
Text1.SetFocus
End If
'If List1.ListIndex <> -1 Then
'Me.List1.RemoveItem (List1.ListIndex)
'tot = 0
'For j = 0 To List1.ListCount - 1
'tot = Val(X + tot)
'Next
Text8 = tot
Fila = Fila - 1
End If
End Sub
'''-------Star comando exportar a un archivo de texto--------r''
Private Sub Command3_Click()
If Len(Text1) <> 11 Then
MsgBox "Ingrese Número de RUC correcto", vbInformation, "Mensaje"
Exit Sub
End If
If Text5 = Empty Then
MsgBox "Ingrese Nombre Proveedor", vbInformation, "Mensaje"
Exit Sub
End If
If Len(Text7) <> 6 Then
MsgBox "Verifique que el número de Lote es Correcto", vbInformation, "Mensaje"
Exit Sub
End If
If Val(Text8) <= 0 Then
MsgBox "Ingrese Datos de Adquiriente", vbInformation, "Mensaje"
Exit Sub
End If
Y = MsgBox("¿Esta Seguro que Desea Generar Archivo .txt?", vbInformation + vbYesNo, "Masivo de Detracciones")
If Y = vbNo Then
Exit Sub
End If
'inicio
Dim nombre As String
Dim v As String
v = "D" & Text1.Text & Text7.Text
Open App.Path & "\" & v & ".txt" For Output As #1
A = LTrim(RTrim(Text5))
b = 35 - Len(A)
rs = Text5
For i = 1 To b
rs = rs & " "
Next
nombre = "P" & Text1 & rs & Text7 & Text8
Print #1, nombre
'Dim i As Integer
'For i = 0 To MSFlexGrid1
'Print #1, MSFlexGrid1
'Next i
Close #1
'fin
MsgBox "El Archivo Generado se encuentra en la ruta " & App.Path & "\D" & Text1.Text & Text7.Text & ".txt", vbInformation, "Masivo de Detracciones"
Call limpiarfrmdetracciones
'Luego mandas llamar al mismo formulario con la instruccion
End Sub
Private Sub Form_Load()
Move (Screen.Width = Width) / 2, (Screen.Height = Height) / 2
Proveedores
MSFlexGrid1.ColWidth(0) = 150
MSFlexGrid1.ColWidth(1) = 1100
MSFlexGrid1.ColAlignment(1) = center
MSFlexGrid1.Col = 1
MSFlexGrid1.Row = 0
MSFlexGrid1.Text = "Ruc"
MSFlexGrid1.ColWidth(2) = 800
MSFlexGrid1.Col = 2
MSFlexGrid1.Row = 0
MSFlexGrid1.Text = "Periodo"
MSFlexGrid1.ColWidth(3) = 1200
MSFlexGrid1.Col = 3
MSFlexGrid1.Row = 0
MSFlexGrid1.Text = "T. Bien o Serv"
MSFlexGrid1.ColWidth(4) = 1100
MSFlexGrid1.Col = 4
MSFlexGrid1.Row = 0
MSFlexGrid1.Text = "N° Cuenta"
MSFlexGrid1.ColWidth(5) = 1100
MSFlexGrid1.Col = 5
MSFlexGrid1.Row = 0
MSFlexGrid1.Text = "Monto"
MSFlexGrid1.ColWidth(6) = 1100
MSFlexGrid1.Col = 6
MSFlexGrid1.Row = 0
MSFlexGrid1.Text = "T. Operación"
End Sub
Private Sub Text1_LostFocus()
Text1.BackColor = vbWhite
If Not Text1.Text = "" Then
With RsProveedores
.Requery
.Find "ruc='" & Trim(Text1.Text) & "'"
If RsProveedores.EOF = False And RsProveedores.BOF = False Then
Text1.Text = RsProveedores("ruc")
Text2.Text = RsProveedores("cuenta")
Text5.Text = RsProveedores("nombre")
Text2 = Format(Text2, "00000000000")
Text3.SetFocus
Else
MsgBox "No existe un proveedor con este ruc", vbCritical, "Error"
Text1.Text = ""
Text2.Text = ""
Text5.Text = ""
Text1.SetFocus
End If
End With
End If
End Sub
Private Sub Text1_GotFocus()
Text1.BackColor = &H80FFFF
Text1.SelLength = Len(Text1)
End Sub
Private Sub TEXT1_KeyPress(keyascii As Integer)
Aceptar_Teclas keyascii, 1
If keyascii = 13 Then
If Text1 = "" Then
xThelp = 1
Frmbuscar.Show 1
Text1 = xCod
End If
Text1 = Format(Text1, "00000000000")
xCod = ""
Saltar (keyascii)
End If
End Sub
Private Sub Text2_KeyPress(keyascii As Integer)
' Pasar al siguiente text con enter
If keyascii = 13 Then
SendKeys "{tab}"
keyascii = 0
End If
' solo valores numéricos
If InStr("0123456789" & Chr(8), Chr(keyascii)) = 0 Then
keyascii = 0
End If
End Sub
Private Sub Text2_LostFocus()
' dar formato 00000000000 a la caja de texto
Text2.Text = Format(Text2.Text, "00000000000")
End Sub
Private Sub Text3_GotFocus()
Text3.BackColor = &H80FFFF
Text3.SelLength = Len(Text3)
End Sub
Private Sub Text3_LostFocus()
Text3.BackColor = vbWhite
End Sub
Private Sub Text3_Change()
If Len(Text3.Text) = Text3.MaxLength Then
Text4.SetFocus
End If
' tomar el valor de dos cajas de texto en una
If IsNumeric(Text3.Text) Then
Text7.Text = Right(Text3.Text, 2) & Text6.Text
End If
End Sub
Private Sub Text3_KeyPress(keyascii As Integer)
' solo valores numéricos
If InStr("0123456789" & Chr(8), Chr(keyascii)) = 0 Then
keyascii = 0
End If
End Sub
Private Sub TEXT4_KeyPress(keyascii As Integer)
' Pasar al siguiente text con enter
If keyascii = 13 Then Saltar (keyascii)
' solo valores numéricos
If InStr("0123456789" & Chr(8), Chr(keyascii)) = 0 Then
keyascii = 0
End If
End Sub
Private Sub Text4_GotFocus()
Text4.BackColor = &H80FFFF
Text4.SelLength = Len(Text4)
End Sub
Private Sub Text4_LostFocus()
' dar formato 00000000000 a la caja de texto
Text4.Text = Format(Text4.Text, "00")
Text4.BackColor = vbWhite
End Sub
Private Sub Text5_KeyPress(keyascii As Integer)
If keyascii = 13 Then
SendKeys "{tab}"
keyascii = 0
End If
keyascii = Asc(StrConv(Chr$(keyascii), vbUpperCase))
End Sub
Private Sub Text6_KeyPress(keyascii As Integer)
If keyascii = 13 Then
SendKeys "{tab}"
keyascii = 0
End If
' solo valores numéricos
If InStr("0123456789" & Chr(8), Chr(keyascii)) = 0 Then
keyascii = 0
End If
End Sub
Private Sub Text6_Change()
If IsNumeric(Text6.Text) Then
Text7.Text = Right(Text3.Text, 2) & Text6.Text
End If
End Sub
Private Sub Text6_GotFocus()
Text6.BackColor = &H80FFFF
Text6.SelLength = Len(Text4)
End Sub
Private Sub Text6_LostFocus()
Text6.Text = Format(Text6.Text, "0000")
Text6.BackColor = vbWhite
End Sub
Private Sub Text9_KeyPress(keyascii As Integer)
' Pasar al siguiente text con enter
If keyascii = 13 Then
SendKeys "{tab}"
keyascii = 0
End If
' solo valores numéricos
If InStr("0123456789" & Chr(8), Chr(keyascii)) = 0 Then
keyascii = 0
End If
End Sub
Private Sub Text10_KeyPress(keyascii As Integer)
' Pasar al siguiente text con enter
If keyascii = 13 Then
SendKeys "{tab}"
keyascii = 0
End If
' solo valores numéricos
If InStr("0123456789" & Chr(8), Chr(keyascii)) = 0 Then
keyascii = 0
End If
End Sub
Private Sub Text10_LostFocus()
' dar formato 00000000000 a la caja de texto
Text10.Text = Format(Text10.Text, "000")
End Sub
Private Sub Text11_KeyPress(keyascii As Integer)
' Pasar al siguiente text con enter
If keyascii = 13 Then
SendKeys "{tab}"
keyascii = 0
End If
' solo valores numéricos
If InStr("0123456789" & Chr(8), Chr(keyascii)) = 0 Then
keyascii = 0
End If
End Sub
Private Sub Text11_LostFocus()
' dar formato 00000000000 a la caja de texto
Text11.Text = Format(Text11.Text, "00")
End Sub
Private Sub Text12_KeyPress(keyascii As Integer)
' Pasar al siguiente text con enter
If keyascii = 13 Then
SendKeys "{tab}"
keyascii = 0
End If
' solo valores numéricos
If InStr("0123456789" & Chr(8), Chr(keyascii)) = 0 Then
keyascii = 0
End If
End Sub
Private Sub Text13_KeyPress(keyascii As Integer)
' solo valores numéricos
If InStr("0123456789" & Chr(8), Chr(keyascii)) = 0 Then
keyascii = 0
End If
End Sub
Private Sub Text13_LostFocus()
' dar formato 00000000000 a la caja de texto
Text13.Text = Format(Text13.Text, "00")
End Sub
Sub limpiarfrmdetracciones()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
End Sub
