Este es el código que uso para compactar las bases de datos. Cosa que suelo hacer bastante a menudo, sobre todo en las que uso en la empresa, que cambian a diario.
Por aquello de la seguridad, mantengo dos copias: la anterior y la última. Más vale prevenir. Nunca se sabe cuando se cortará la luz o se quedará colgado el equipo... así que, me curo en salud.

Código: Seleccionar todo

 
'Cerrar la base (esto sólo si la tienes abierta...)
Db.Close
'Liberar memoria y "desligarla"
Set Db = Nothing
'
'Tomar el nombre sin la extensión
sTmp = ""
i = InStr(NombreBase, ".")
If i Then
	p = i - 1
Else
	p = Len(NombreBase)
End If
sTmp = Left$(NombreBase, p)
'Buscar \, para tomar el directorio (path)
For i = p To 1 Step -1
	If Mid$(NombreBase, i, 1) = "\" Then
		sTmp = Left$(NombreBase, i)
		Exit For
	End If
Next
If Right$(sTmp, 1) <> "\" Then
	sTmp = sTmp & "\"
End If
'Todo este proceso es para estar seguro de que se quede una copia
'en caso de que falle la compactación...
dBaseTmp = sTmp & "~dBase2.mdb"
If Len(Dir$(dBaseTmp)) Then Kill dBaseTmp
If Len(Dir$(sTmp & "~dBase1.mdb")) Then Kill sTmp & "~dBase1.mdb"
'Esta es la madre del cordero, se pueden usar otras "versiones", es cuestión de adecuarte.
CompactDatabase NombreBase, dBaseTmp, dbLangSpanish, dbVersion20
'Guardar una copia de como estaba antes
Name NombreBase As sTmp & "~dBase1.mdb"
'Esta es la base ya compactada, así que asignar el nombre
Name dBaseTmp As NombreBase
'Borrar los ficheros LDB
If Len(Dir$(sTmp & "*.ldb")) Then Kill sTmp & "*.ldb"

Código: Seleccionar todo

Public Sub MSHFG_Print(ByVal gri As Control, cabecer As String, peu As String)
Set grid = gri
ReDim dimen(grid.Cols)
If grid.Rows = 1 Then Exit Sub
'Agafo l'amplada del grid total a imprimir
ample = 0
For x = 0 To grid.Cols - 1
grid.Col = x
If grid.CellWidth > 20 Then
If grid.CellWidth < 200 Then grid.ColWidth(x) = 200
ample = grid.CellWidth + ample
End If
dimen(x) = grid.CellWidth
Next x
grid.LeftCol = 1
'ja tinc el ample a imprimir
tppx = Printer.TwipsPerPixelX
tppy = Printer.TwipsPerPixelY
cabecera = cabecer
pie = peu
x0 = (Printer.ScaleWidth - ample) / 2
y0 = (Printer.Height - Printer.ScaleHeight) / 2
y1 = y0
Printer.CurrentY = y1
grid.Col = 0
grid.Row = 0
For Row = 0 To grid.Rows - 1
If Row = 0 Then PosCapMSHFG
'faig la ultima linea del grid si ha acabat sense cuadricular
If Printer.ScaleHeight - 1500 < y1 Then 'finalitzo pag i poso capçelera.
If cuadro = True Then Printer.Line (x0, y1)-(x0 + ample, y1), vbBlack, B
Printer.CurrentY = Printer.ScaleHeight - 500
Printer.CurrentX = x0
Printer.Print pie
Printer.CurrentX = Printer.ScaleWidth - 1000
Printer.Print "Pág " & Printer.Page
Printer.NewPage
PosCapMSHFG
End If
ImpLinMSHFG

Next
'faig la ultima linea del grid si ha acabat sense cuadricular
If cuadro = True Then Printer.Line (x0, y1)-(x0 + ample, y1), vbBlack, B
Printer.CurrentY = Printer.ScaleHeight - 500
Printer.CurrentX = x0
Printer.Print pie
Printer.CurrentX = Printer.ScaleWidth - 1000
Printer.Print "Pág " & Printer.Page
Printer.EndDoc
End Sub


Private Sub ImpLinMSHFG()
alt = grid.RowHeight(Row)

Printer.FillStyle = 1 'solido 0
Printer.CurrentX = x0
Printer.CurrentY = y1 'printer.CurrentY - tppy
If cuadro Then
Printer.Line -Step(ample + tppx, alt + tppy), vbBlack, B
Else
Printer.Line (x0 + ample, y1)-(x0 + ample, y1 + alt + tppy), vbBlack, B
End If
cuadro = Not cuadro
For Col = 0 To grid.Cols - 1
If Col = 0 Then
x1 = x0 'COMENÇO PER L'ESQUERRA
'alt = printer.FontSize * tppy * 5
Else
x1 = x1 + dimen(Col - 1)
End If
If dimen(Col) < 20 Then Col = Col + 1
If dimen(Col) > 20 Then
Printer.CurrentX = x1 + tppx
Printer.CurrentY = y1 '+ tppy
Printer.Line (x1, y1 + tppy)-(x1, alt + y1 - tppy), vbBlack, B
Printer.CurrentX = x1 + 30 / tppx
Printer.CurrentY = y1 '+ tppy
texte = grid.TextArray(grid.Cols * Row + Col)
Do While Printer.TextWidth(texte) > dimen(Col) And Len(texte) > 0
texte = Left(texte, Len(texte) - 1)
punts = True
Loop
If punts = True And Len(texte) > 0 Then texte = Left(texte, Len(texte) - 2) & "..."
punts = False
If grid.ColAlignment(Col) > 5 Then Printer.CurrentX = Printer.CurrentX + dimen(Col) - Printer.TextWidth(texte) - 30 / tppx
If grid.ColAlignment(Col) >= 3 And grid.ColAlignment(Col) <= 5 Then Printer.CurrentX = Printer.CurrentX + (dimen(Col) - Printer.TextWidth(texte)) / 2

Printer.Print texte
End If
Next
y1 = y1 + grid.RowHeight(Row) '- tppy 'y + alto de la fila actual

End Sub

Public Sub PosCapMSHFG()
Printer.CurrentY = y0
Printer.FontSize = 20
Printer.ForeColor = vbBlue
Printer.FontBold = True
Printer.CurrentX = (Printer.Width - Printer.ScaleWidth) + (Printer.ScaleWidth - Printer.TextWidth(cabecera)) / 2
Printer.Print cabecera
Printer.FontSize = 8.25
Printer.ForeColor = vbBlack
Printer.FontBold = False
y1 = Printer.CurrentY + 300 'separaciò amb el titol
'Row = trow
'grid.Row = Row
'grid.Col = 0
For Col = 0 To grid.Cols - 1
'grid.Col = Col
If Col = 0 Then
x1 = x0 'COMENÇO PER L'ESQUERRA
'alt = printer.FontSize * tppy * 5
Else
x1 = x1 + dimen(Col - 1)
End If
If dimen(Col) < 20 Then Col = Col + 1
'If grid.Col = 9 Or grid.Col = 11 Then x1 = x1 + 400
'grid.Col = Col
If dimen(Col) > 20 Then
Printer.CurrentX = x1 + tppx
Printer.CurrentY = y1 '+ tppy
Printer.Line (x1, y1 + tppy)-(x1, alt + y1 - tppy), vbBlack, B
Printer.CurrentX = x1 + 15 / tppx
Printer.CurrentY = y1 '+ tppy
texte = grid.TextArray(Col)
Do While Printer.TextWidth(texte & "...") > dimen(Col) And Len(texte) > 0
texte = Left(texte, Len(texte) - 1)
punts = True
Loop
If punts = True And Len(texte) > 0 Then texte = Left(texte, Len(texte) - 2) & "..."
punts = False
Printer.CurrentX = Printer.CurrentX + (dimen(Col) - Printer.TextWidth(texte)) / 2
Printer.Print texte
End If
Next
y1 = y1 + grid.RowHeight(Row) '- tppy 'y + alto de la fila actual
cuadro = True
If Row = 0 Then Row = 1

End Sub
Bueno en forma de pensar esta es una de las manera, puesto que imprime un grid tal como se, tipo hoja de excel,(no lo habia publicado porque no lo habia encontrado.)

Código: Seleccionar todo

'**************************************
' Formatear e impremir un MSFLEXIGRID
' Entrada el FlexiGrid que quiere imprimir
' No retorna nada
'************************************
 
 
Sub PrintGrid(pGrid As MSFlexGrid, sTitulo As String, pHorizontal As Boolean)
' pGrid = El Gri a imprimir
' sTitulo = El título de la página
' pHorizontal = True para imprimir página invertida
 
On Error GoTo ErrorImpresion
Dim i As Integer
Dim iMaxRow As Integer
Dim j As Integer
Dim msfGrid As MSFlexGrid
Dim iPaginas As Integer
Printer.ColorMode = vbPRCMMonochrome
Printer.PrintQuality = 160
 
 
Set msfGrid = fMainForm.MSFlexGrid1
msfGrid.FixedCols = 0
msfGrid.Clear
 
 
If pHorizontal = True Then
Printer.Orientation = vbPRORLandscape
iMaxRow = 44
Else
Printer.Orientation = vbPRORPortrait
iMaxRow = 57
End If
 
' calcula el número de páginas
 
 
If pGrid.Rows Mod iMaxRow = 0 Then
iPaginas = pGrid.Rows \ iMaxRow
Else
iPaginas = pGrid.Rows \ iMaxRow + 1
End If
msfGrid.Rows = iMaxRow
msfGrid.Cols = pGrid.Cols
 
 
For i = 0 To pGrid.Cols - 1
msfGrid.ColWidth(i) = pGrid.ColWidth(i)
Next
 
' impresion de un logo o de una imagen que Vd. quiera
 
Printer.PaintPicture fMainForm.ImageList1.ListImages(1).Picture, 0, 0, 4300, 600
' imprime título
Printer.CurrentY = 650
Printer.FontName = "Courier New"
Printer.FontBold = True
Printer.FontSize = 12
Printer.Print sTitulo
Printer.Print
' justifica a la derecha fecha de impresión
 
 
 
If pHorizontal = True Then
Printer.CurrentX = 10000
Else
Printer.CurrentX = 7000
End If
Printer.CurrentY = 0
Printer.FontSize = 10
Printer.Print Now & " - Pág 1 de " & iPaginas
 
 
For i = 0 To pGrid.Rows - 2 + iPaginas
 
 
If i Mod iMaxRow = 0 And i > 0 Then
 
 
With msfGrid
.Row = 0
.Col = 0
.ColSel = 0
.RowSel = 0
 
 
If pHorizontal Then
Printer.PaintPicture .Picture, 20, 1250, 15000, 10350
Else
Printer.PaintPicture .Picture, 20, 1250, 11400, 13950
End If
End With
Printer.NewPage
msfGrid.Clear
 
 
For j = 0 To msfGrid.Cols - 1
' restablece títulos
msfGrid.TextMatrix(0, j) = pGrid.TextMatrix(0, j)
Next
' print logo
Printer.PaintPicture fMainForm.ImageList1.ListImages(23).Picture, 0, 0, 4300, 600
Printer.CurrentY = 650
Printer.FontSize = 12
Printer.Print sTitulo
Printer.Print
' justifica a la derecha fecha de impres
' ión
 
 
If pHorizontal = True Then
Printer.CurrentX = 10000
Else
Printer.CurrentX = 7000
End If
Printer.CurrentY = 0
Printer.FontSize = 10
Printer.Print Now & " - Pág " & i \ iMaxRow + 1 & " de " & iPaginas
i = i + 1 ' deja títulos
End If
 
 
For j = 0 To msfGrid.Cols - 1
msfGrid.TextMatrix(i Mod iMaxRow, j) = pGrid.TextMatrix(i - i \ iMaxRow, j)
Next
Next
 
 
With msfGrid
.Row = 0
.Col = 0
.ColSel = 0
.RowSel = 0
 
 
If pHorizontal Then
Printer.PaintPicture .Picture, 20, 1250, 15000, 10350
Else
Printer.PaintPicture .Picture, 20, 1250, 11400, 13950
End If
End With
Printer.EndDoc
MsgBox sTitulo & vbCrLf & "Se ha(n) enviado " & iPaginas & " página(s) a la impresora " & Printer.DeviceName, vbInformation, Printer.Port
 
salir:
Set msfGrid = Nothing
Exit Sub
ErrorImpresion:
Printer.KillDoc
MsgBox "Compruebe la impresora", vbCritical, "Printer Error"
Resume salir
End Sub
este ejemplo usa dos Grid's uno donde esta imformación y otro donde va imprimiendo hoja tras hoja, tipo excel, lo recomiendo mucho puesto que es muy estético..

Código: Seleccionar todo

 On Local Error Resume Next
 Dim i As Integer
 If Metida = True Then
 Exit Sub
 End If
 For i = 1 To Me.ListadoDetalleFactura.Rows - 1
 If Me.ListadoDetalleFactura.TextMatrix(i, 1) = "" Then' nos basamo en una columna para determinar donde termina el area con texto.. o bien si contiene algo la linea del flexgrid
 Else
  Dim db As Connection
 		  Dim adoPrimaryRS As Recordset
 		  Set db = New Connection
 		  Set adoPrimaryRS = New Recordset
 		  db.CursorLocation = adUseClient
 		  db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & BasePath' base path es direccionamiento a la base de datos
 		  adoPrimaryRS.Open "Select * From detalle_cargos_habitacion", db, adOpenStatic, adLockOptimistic
 		  adoPrimaryRS.AddNew
 		  adoPrimaryRS!id_registro = CodigoRegistro
 		  adoPrimaryRS!id_servicio = Val(Me.ListadoDetalleFactura.TextMatrix(i, 1))
 		  adoPrimaryRS!ticket = Val(Me.ListadoDetalleFactura.TextMatrix(i, 3))
 		  adoPrimaryRS!id_empleado = CodU
 		  adoPrimaryRS!id_sesion = Sesion
 		  adoPrimaryRS!Fecha = Date
 		  adoPrimaryRS!hora = Time
 		  adoPrimaryRS!cantidad = Val(Me.ListadoDetalleFactura.TextMatrix(i, 4))
 		  adoPrimaryRS!Total = Val(Me.ListadoDetalleFactura.TextMatrix(i, 5))
 		  adoPrimaryRS.Update
 End If
 Next i
 If Err <> 0 Then
 MsgBox "No se han podido guardar todos los datos por el siguiente error " & Err, vbInformation, "Error"
 Metida = True
 Exit Sub
 End If
Grid con casillas editables.
En el ejemplo veremos cómo usar tanto un control TextBox como un comboBox.
como verás en el código es fácil decidir si debemos mostrar el textbox o el combo... dependiendo de lo que necesitemos usar... en caso de que necesites usar diferentes combos, te recomiendo que uses un array del control combo1 para que te resulte fácil de interceptar las pulsaciones y otras acciones con dichos controles... puede que en otra ocasión amplíe este ejemplo con esto que digo, además de usar un control checkbox... pero eso será en otra ocasión... así que... paciencia.

Te explico lo que el código hace... aunque puedes seguirlo sin problemas, eso espero, con los comentarios incluidos en el código de ejemplo.

En principio el Grid sólo tendrá una fila "disponible", cuando pulsamos en una de las celdas de la última fila, la cual está identificada con ">>*", se creará una nueva fila... cuando pruebes el código de ejemplo, sabrás de que estoy hablando.

Para introducir algo en cualquiera de las celdas, podemos hacerlo de varias formas:
-haciendo doble-click en la celda a editar,
-escribiendo directamente en el grid,
-pulsando la tecla F2

Para aceptar lo que hemos escrito, pulsaremos Intro o simplemente haciendo Click en cualquier otra celda.
Si se pulsa ESC, se cancela la edición de la celda.

En el código mostrado, uso dos procedimientos para guardar el contenido del grid en un fichero de texto y para leer de ese fichero y asignarlo al grid. Este código tendrás que adaptarlo a los campos que tengas en el grid, aunque usado tal y como lo muestro te puede ser útil al 100%.

Bueno, me dejo de "cháchara" y te muestro el código.

El formulario contiene los siguientes controles:
Un control FlexGrid llamado Grid2,
un TextBox llamado Text1,
un ComboBox llamado Combo1,
un PictureBox llamado picStatus con la propiedad Align = 2 (para que se ajuste a la parte inferior),
una etiqueta llamada lblStatus, (insertada en el picStatus),
un botón llamado cmdSalir, (insertado en el picStatus).

Nota:
No tienes que preocuparte por "insertar" los dos últimos controles mencionados en el PictureBox, ya que eso se hace en el código del evento Form_Load

Como bono extra, una función para "interpretar" fechas y asignar el formato que queramos a partir de varias formas de entrada, por ejemplo, acepta fechas con y sin separadores, e incluso sin indicar el año...

Código: Seleccionar todo


'------------------------------------------------------------------------------
' Prueba de Grid con celdas editables							 (09/May/01)
' Revisado: 17/May/2001
'
' Ejemplo de código con TextBox y ComboBox
'
' ©Guillermo 'guille' Som, 2001
'------------------------------------------------------------------------------
Option Explicit
 
Private sFicDatos As String		 ' Fichero con los datos del grid
Const cNuevaFila As String = ">>*" ' Para indicar que es una nueva fila
Private ControlVisible As Boolean ' Si el control está o no visible (editándose)
Private LastRow As Long			 ' La última fila en que se editó
Private LastCol As Long			 ' La última columna en que se editó
 
Private Sub cmdSalir_Click()
	Unload Me
End Sub
 
Private Sub Combo1_Change()
	If Combo1.Visible Then
		Grid2.TextMatrix(LastRow, LastCol) = Combo1.Text
		AsignarCelda
	End If
End Sub
 
Private Sub Combo1_Click()
	Combo1_Change
End Sub
 
Private Sub Combo1_KeyPress(KeyAscii As Integer)
	If KeyAscii = vbKeyReturn Then
		KeyAscii = 0
	 AsignarCelda
		SiguienteCelda
	ElseIf KeyAscii = vbKeyEscape Then
		KeyAscii = 0
		Combo1.Visible = False
	End If
End Sub
 
Private Sub Form_Load()
	Dim i As Long
	Dim s As String
	'
	picStatus.Height = 585
	With lblStatus
		.Caption = " Código de ejemplo: ©Guillermo 'guille' Som, 2001 <[email protected]>"
		Set .Container = picStatus
		.Height = 285
		.BorderStyle = vbFixedSingle
		.Left = 90
		.Top = 120
		.Visible = True
	End With
	With cmdSalir
		Set .Container = picStatus
		.Height = 405
		.Top = 60
		.Visible = True
	End With
	'
	s = App.Path
	sFicDatos = s & IIf(Right$(s, 1) = "\", "", "\") & "PruebaGrid.txt"
	'
	With Combo1
		.Clear
		For i = 1 To 20
			.AddItem i
		Next
	End With
	'
	OcultarControles
	'
	CabeceraGrid
	LeerDatos
End Sub

Código: Seleccionar todo

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 	' Guardar los datos del grid
 	GuardarDatos
 End Sub
 
 Private Sub Form_Resize()
 	' Reajustar el tamaño del grid al de la ventana
 	' Si tuviesemos otro control, por ejemplo una barra de estado,
 	' restarle el ancho de la misma al Grid
 	If WindowState <> vbMinimized Then
 		Grid2.Move 0, 0, ScaleWidth, ScaleHeight - picStatus.Height
 		With cmdSalir
 			.Left = picStatus.ScaleWidth - .Width - 90
 			lblStatus.Width = .Left - 120 - lblStatus.Left
 		End With
 	End If
 End Sub
 
 Private Sub Grid2_Click()
 	' Cuando se hace un sólo click en otra columna,
 	' asigna el valor seleccionado, (como si se pulsara intro)
 	AsignarCelda
 End Sub
 
 Private Sub Grid2_DblClick()
 	' Editar al hacer dobleclick
 	LastRow = Grid2.Row
 	LastCol = Grid2.Col
 	'
 	OcultarControles
 	'
 	MostrarCelda
 End Sub
 
 Private Sub Grid2_KeyDown(KeyCode As Integer, Shift As Integer)
 	' Editar si se pulsa F2
 	If KeyCode = vbKeyF2 Then
 		MostrarCelda
 	ElseIf KeyCode = vbKeyDelete Then
 		' Borrar las filas seleccionadas						    (13/May/01)
 		BorrarFilas
 	End If
 End Sub
 
 Private Sub Grid2_KeyPress(KeyAscii As Integer)
 	Select Case KeyAscii
 	' Si se pulsa Intro, editar la celda
 	Case vbKeyReturn
 		KeyAscii = 0
 		MostrarCelda
 	' Cancelar si se pulsa ESC
 	Case vbKeyEscape
 		KeyAscii = 0
 		AsignarCelda
 	' Si se pulsa cualquier letra, editar la celda
 	Case 32 To 255
 		MostrarCelda
 		With Text1
 	  	  If .Visible Then
 			    '.Text = .Text & Chr$(KeyAscii)
 				.Text = Chr$(KeyAscii)
 				.SelStart = Len(.Text) + 1
 			End If
 		End With
 	End Select
 End Sub
 
 Private Sub Grid2_Scroll()
 	' Comprobar si la columna en la que está el control está visible
 	' si es así, ocultar los controles
 	'
 	If Grid2.ColIsVisible(LastCol) = False Then
 		OcultarControles
 		Exit Sub
 	End If
 	If Grid2.RowIsVisible(LastRow) = False Then
 		OcultarControles
 		Exit Sub
 	End If
 	' Comprobar si estaba visible antes de ocultarlo
 	' y posicionarlo en la misma celda
 	If ControlVisible Then
 		MostrarCelda
 	End If
 End Sub
 
 Private Sub MostrarCelda()
 	Static YaEstoy As Boolean
 	'
 	' Salir si es una de las celdas fijas
 	If Grid2.Col <= Grid2.FixedCols - 1 Or Grid2.Row <= Grid2.FixedRows - 1 Then
 		Exit Sub
 	End If
 	'
 	If YaEstoy Then Exit Sub
 	YaEstoy = True
 	'
 	OcultarControles
 	'
 	LastRow = Grid2.Row
 	LastCol = Grid2.Col
 	'
 	' Si es una nueva celda
 	With Grid2
 		If .TextMatrix(LastRow, 0) = cNuevaFila Then
 			.Rows = .Rows + 1
 			.TextMatrix(LastRow, 0) = LastRow
 			.TextMatrix(.Rows - 1, 0) = cNuevaFila
 		End If
 	End With
 	'
 	Select Case LastCol
 	Case 2
 		Combo1.Text = Grid2.TextMatrix(LastRow, LastCol)
 		Combo1.Move Grid2.CellLeft - Screen.TwipsPerPixelX, Grid2.CellTop - Screen.TwipsPerPixelY
 		Combo1.Width = Grid2.CellWidth + Screen.TwipsPerPixelX * 2
 		Combo1.Visible = True
 		Combo1.ZOrder
 		Combo1.SetFocus
 	Case Else
 		Text1.Move Grid2.CellLeft - Screen.TwipsPerPixelX, Grid2.CellTop - Screen.TwipsPerPixelY, Grid2.CellWidth + Screen.TwipsPerPixelX * 2, Grid2.CellHeight + Screen.TwipsPerPixelY * 2
 		Text1.Text = Grid2.Text
 		If Len(Grid2.Text) = 0 Then
 			If LastRow > 1 Then
 				Text1.Text = Grid2.TextMatrix(LastRow - 1, LastCol)
 			End If
 		End If
 		Text1.Visible = True
 		If Text1.Visible Then
 			Text1.ZOrder
 			Text1.SetFocus
 		End If
 	End Select
 	'
 	ControlVisible = True
 	'
 	YaEstoy = False
 End Sub
 
 Private Sub SiguienteCelda()
 	If Grid2.Col < Grid2.Cols - 1 Then
 		Grid2.Col = Grid2.Col + 1
 	Else
 		Grid2.Col = 1
 		If Grid2.Row < Grid2.Rows - 1 Then
 			Grid2.Row = Grid2.Row + 1
 		End If
 	End If
 End Sub
 
 Private Sub Text1_GotFocus()
 	With Text1
 		' Posicionar el cursor al final
 		.SelStart = Len(.Text)
 	End With
 End Sub
 
 Private Sub Text1_KeyPress(KeyAscii As Integer)
 	' Si se pulsa Intro, aceptar lo que se ha escrito
 	If KeyAscii = vbKeyReturn Then
 		KeyAscii = 0
 		AsignarCelda
 		SiguienteCelda
 	' Si se pulsa ESC, cancelar la edición
 	ElseIf KeyAscii = vbKeyEscape Then
 		KeyAscii = 0
 		Text1.Visible = False
 		ControlVisible = False
 	End If
 End Sub
 
 Private Sub AsignarCelda()
 	' Asignar al grid el texto escrito o seleccionado del combo
 	Dim s As String
 	'
 	OcultarControles
 	ControlVisible = False
 	'
 	' Asignar el texto anterior a la celda
 	Select Case LastCol
 	Case 2
 		'
 		Grid2.TextMatrix(LastRow, LastCol) = Combo1.Text
 	Case Else
 		s = Text1.Text
 		' si es la columna de la fecha...
 		If LastCol = 1 Then ' Fecha
 			s = AjustarFecha(s)
 		End If
 		Grid2.TextMatrix(LastRow, LastCol) = s
 	End Select
 End Sub
 
 

Código: Seleccionar todo

 Private Function AjustarFecha(ByVal sFecha As String) As String
 	' Ajustar la cadena introducida a formato de fecha			  (27/Abr/01)
 	Dim i As Long
 	Dim s As String
 	'
 	If sFecha = "" Then
 		AjustarFecha = ""
 		Exit Function
 	End If
 	'
 	'On Error Resume Next
 	On Error GoTo 0
 	'
 	' Comprobar si se usan puntos como separador
 	' si es así, cambiarlos por /
 	Do
 		i = InStr(sFecha, ".")
 		If i Then
 			Mid$(sFecha, i, 1) = "/"
 		End If
 	Loop While i
 	'
 	' Comprobar si se usan - como separador
 	' si es así, cambiarlos por /
 	Do
 		i = InStr(sFecha, "-")
 		If i Then
 			Mid$(sFecha, i, 1) = "/"
 		End If
 	Loop While i
 	'
 	s = ""
 	Do
 		i = InStr(sFecha, "/")
 		If i Then
 			s = s & Right$("0" & Left$(sFecha, i - 1), 2) & "/"
 			sFecha = Mid$(sFecha, i + 1)
 		End If
 	Loop While i
 	sFecha = s & sFecha
 	'
 	If InStr(sFecha, "/") Then
 		If Len(sFecha) = 5 Then
 			' Si es igual a 5 caracteres, es que falta el año
 			sFecha = sFecha & "/"
 		ElseIf Len(sFecha) < 3 Then
 			' Si es menor de 3 caracteres es que falta el mes
 			sFecha = sFecha & "/" & CStr(Month(Now)) & "/"
 		End If
 	ElseIf Len(sFecha) < 3 Then
 		sFecha = sFecha & "/" & CStr(Month(Now)) & "/"
 	Else
 		s = ""
 		For i = 1 To 2
 	  	  s = s & "/" & Mid$(sFecha, (i - 1) * 2 + 1, 2)
 		Next
 		s = s & "/" & Mid$(sFecha, 5)
 		sFecha = s
 	End If
 	sFecha = Trim$(sFecha)
 	'
 	' Comprobar si tiene una barra al principio, si es así, quitarla
 	If Left$(sFecha, 1) = "/" Then
 		sFecha = Mid$(sFecha, 2)
 	End If
 	' Si tiene una barra al final, es que falta el año
 	If Right$(sFecha, 1) = "/" Then
 		sFecha = sFecha & CStr(Year(Now))
 	End If
 	'
 	' Convertir la fecha, por si no se especifican todos los caracteres
 	' Nota: Aquí puedes usar el formato que más te apetezca
 	sFecha = Format$(sFecha, "dd/mm/yyyy")
 	'
 '	' Si no es una fecha correcta...
 '	If IsDate(sFecha) = False Then
 '		AjustarFecha = sFecha
 '	Else
 '	    AjustarFecha = sFecha
 '	End If
 	'
 	Err = 0
 	'
 	AjustarFecha = sFecha
 End Function
 
 Private Sub CabeceraGrid()
 	' Asignar las cabeceras del grid y asignación de valores predeterminados
 	Dim i As Long
 	'
 	With Grid2
 		.FixedRows = 1
 		.FixedCols = 1
 		.ScrollBars = flexScrollBarBoth
 		.AllowUserResizing = flexResizeColumns
 		.Cols = 11				  ' Número de columnas, contando la cabecera
 		.Rows = 2				   ' Número de filas, contando la cabecera
 								    ' el número de filas se asignará dinámicamente
 		.ColWidth(0) = 600		  ' El ancho de la columna 0
 		'
 		' Asignar los nombres de las cabeceras y el ancho de las columnas
 		.TextArray(1) = "Fecha"
 		.ColWidth(1) = 1100
 		.TextArray(2) = "Número"
 		.ColWidth(2) = 900
 		.TextArray(3) = "Nombre"
 		.ColWidth(3) = 1500
 		.TextArray(4) = "Apellidos"
    	 .ColWidth(4) = 2000
 		.TextArray(5) = "Domicilio"
 		.ColWidth(5) = 2500
 		.TextArray(6) = "Población"
 		.ColWidth(6) = 2000
 		.TextArray(7) = "Provincia"
 		.ColWidth(7) = 1600
 		.TextArray(8) = "Teléfonos"
    	 .ColWidth(8) = 1500
 		.TextArray(9) = "e-mail"
 		.ColWidth(9) = 1200
 		.TextArray(10) = "Observaciones"
 		.ColWidth(10) = 2500
 		'
 		' Mostrar los números en las filas
 		For i = 1 To .Rows - 1
 			.TextMatrix(i, 0) = i
 		Next
 		'
 		' Esto indicará que es una nueva fila
 		' (asignarla a la primera columna de la última fila)
 		.TextMatrix(.Rows - 1, 0) = cNuevaFila
 	End With
 End Sub
 
 Private Sub BorrarFilas()
 	' Borrar las filas seleccionadas							    (13/May/01)
 	Dim i As Long
 	Dim j As Long
 	Dim k As Long
 	Dim n As Long
 	'
 	' Si está seleccionada la última fila, no borrarla
 	If Grid2.RowSel = Grid2.Rows - 1 Then
 		Beep
  	   Exit Sub
 	End If
 	If Grid2.Row = Grid2.Rows - 1 Then
 		Beep
 		Exit Sub
 	End If
 	'
 	' Borrar siempre desde la fila mayor a la menor
 	i = Grid2.Row
 	j = Grid2.RowSel
 	If i < j Then
 		k = i
 		i = j
 	    j = k
 	End If
 	For n = i To j Step -1
 		Grid2.RemoveItem n
 	Next
 	LastRow = Grid2.Rows - 1
 	LastCol = 1
 	Grid2.Col = LastCol
 	Grid2.Row = LastRow
 	Grid2.RowSel = LastRow
 	Grid2.ColSel = LastCol
 End Sub
 
El codigo a continuación tiene un Procedimiento llamado
DrawBarCode, el cual recibe el codigo del item, la descripción del mismo y un control PictureBox, el cual contendrá el codigo de barras.

Sólo debes diseñar un form con 3 controles (2 textBox y 1 PictureBox), luego
ejecutas

Call DrawBarcode(codigo_item, Descripcion_item, PictureBox)

Código: Seleccionar todo

Sub DrawBarcode(ByVal bc_string As String, sDescripcion As String, VLPrecio as String, obj As Control)

Dim xpos!, y1!, y2!, dw%, th!, tw, new_string$
Dim bc(90) As String
Dim sAux As String
Dim I As Byte

bc(1) = "1 1221" 'pre-amble
bc(2) = "1 1221" 'post-amble
bc(48) = "11 221" 'dígitos
bc(49) = "21 112"
bc(50) = "12 112"
bc(51) = "22 111"
bc(52) = "11 212"
bc(53) = "21 211"
bc(54) = "12 211"
bc(55) = "11 122"
bc(56) = "21 121"
bc(57) = "12 121"
'Letras Mayúsculas
bc(65) = "211 12" 'A
bc(66) = "121 12" 'B
bc(67) = "221 11" 'C
bc(68) = "112 12" 'D
bc(69) = "212 11" 'E
bc(70) = "122 11" 'F
bc(71) = "111 22" 'G
bc(72) = "211 21" 'H
bc(73) = "121 21" 'I
bc(74) = "112 21" 'J
bc(75) = "2111 2" 'K
bc(76) = "1211 2" 'L
bc(77) = "2211 1" 'M
bc(78) = "1121 2" 'N
bc(79) = "2121 1" 'O
bc(80) = "1221 1" 'P
bc(81) = "1112 2" 'Q
bc(82) = "2112 1" 'R
bc(83) = "1212 1" 'S
bc(84) = "1122 1" 'T
bc(85) = "2 1112" 'U
bc(86) = "1 2112" 'V
bc(87) = "2 2111" 'W
bc(88) = "1 1212" 'X
bc(89) = "2 1211" 'Y
bc(90) = "1 2211" 'Z
'Misceláneos Caracteres
bc(32) = "1 2121" 'Espacio
bc(35) = "" '# no se puede realizar
bc(36) = "1 1 1 11" '$
bc(37) = "11 1 1 1" '%
bc(43) = "1 11 1 1" '+
bc(45) = "1 1122" '-
bc(47) = "1 1 11 1" '/
bc(46) = "2 1121" '.
bc(64) = "" '@ no se puede realizar
bc(65) = "1 1221" '*

bc_string = UCase(bc_string) 'Convertir a mayúsculas

'Dimensiones
obj.ScaleMode = 2 'Pixeles
obj.Cls
obj.Picture = Nothing
dw = CInt(obj.ScaleHeight / 40) 'Espacio entre barras
If dw < 1 Then dw = 1
th = obj.TextHeight(bc_string) 'Alto texto
tw = obj.TextWidth(bc_string) 'Ancho texto
new_string = Chr$(1) & bc_string & Chr$(2) 'Agregar pre-amble, post-amble
y1 = obj.ScaleTop + 12
y2 = obj.ScaleTop + obj.ScaleHeight - 1.5 * th
obj.Width = 1.1 * Len(new_string) * (15 * dw) * obj.Width / obj.ScaleWidth

'Dibujar cada caracter en el string barcode
xpos = obj.ScaleLeft
For n = 1 To Len(new_string)
c = Asc(Mid(new_string, n, 1))
If c > 90 Then c = 0
bc_pattern$ = bc(c)
'Dibujar cada barra
For I = 1 To Len(bc_pattern$)
Select Case Mid(bc_pattern$, I, 1)
Case " "
'Espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
Case "1"
'Espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'Línea
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &H0&, BF
xpos = xpos + dw
Case "2"
'Espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'Ancho línea
obj.Line (xpos, y1)-(xpos + 2 * dw, y2), &H0&, BF
xpos = xpos + 2 * dw
End Select
Next
Next

'Mas espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw

'Medida final y tamaño
obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
obj.CurrentX = 1
obj.CurrentY = 1
If VLPrecio = "0.00" Then VLPrecio = ""
If xpos - obj.TextWidth(VLPrecio) - 10 < obj.TextWidth(sDescripcion) Then
sAux = ""
For I = 1 To Len(sDescripcion)
If xpos - obj.TextWidth(VLPrecio) - 10 < obj.TextWidth(sAux) Then
Exit For
Else
sAux = sAux & Mid(sDescripcion, I, 1)
End If
Next I
obj.Print sAux
Else
obj.Print sDescripcion
End If
obj.CurrentX = xpos - obj.TextWidth(VLPrecio)
obj.CurrentY = 1
obj.Print VLPrecio
obj.CurrentX = (obj.ScaleWidth - tw) / 2
obj.CurrentY = y2 + 0.25 * th
obj.Print bc_string

'Copiar a clipboard
obj.Picture = obj.Image
Clipboard.Clear
Clipboard.SetData obj.Image, 2
End Sub
Hola. Create un formulario llamado Form1, y en el pon un CheckBox, llamado Check1. Depués añade este código.

Código: Seleccionar todo

  Private Sub Form_Load()
  	Check1.Value = GetSetting(App.Title, Form1.Name, Check1.Name, vbChecked) 
  End Sub

Código: Seleccionar todo

  Private Sub Form_Unload(Cancel As Integer)
  	SaveSetting App.Title, Form1.Name, Check1.Name, Check1.Value
  End Sub
Tendrás que hacer lo mismo con cada uno de los controles de tu formulario.
Se podría hacer incluso un procedimiento para guardar en un bucle todas las propiedades de todos los controles de un formulario, pero eso te lo dejamos investigar a vos.
en caso de que fuera un texto un label se reemplaza el codigo por las propiedades de un texto, por ejemplo

Código: Seleccionar todo

   Private Sub Form_Load()
  text1.text = GetSetting(App.Title, Form1.Name, text1.name, vbChecked) 
  End Sub

Código: Seleccionar todo

   Private Sub Form_Unload(Cancel As Integer)
   	SaveSetting App.Title, Form1.Name, text1.name, text1.text
   End Sub
para una label seria igual pero con label1.caption..
Una barra del progreso exhibe una barra azul creciente o que se contrae para dar la regeneración de usuario en una cierta clase de operación. Esto puede descargar un archivo del Internet o de la terminación de una tarea muy larga. La barra azul puede ser dividida en segmentos o puede ser sólida. El ProgressBar está situado en los controles comunes de Microsoft Windows así que agregar este control a su caja de herramientas que usted tiene que chascar encendido proyectos sobre la barra de menú, después chascar encendido componentes y los componentes caja aparecerá de diálogo, después enrollan abajo y localizan los controles 6 del campo común de Microsoft Windows y ponen un cheque en la caja de cheque al lado de ella y chascan encendido MUY BIEN.

* Nota: CTRL + t también abre la caja de diálogo de los componentes

Características, métodos y acontecimientos

características significativas

Movimiento en sentido vertical(Scrolling): se determina si la exhibición del progreso aparece sólida o dividida en segmentos
Negotiate: esto se determina si un control que puede ser alineado está exhibido cuando un objeto activo en la forma exhibe unos o más toolbars.
Orientación( Orientación): se determina si la orientación es horizontal o vertical
Valor(Value): el ajuste actual de la barra del progreso
Aspecto(Appearance): esto hace que la barra del progreso aparece o en 3D o plano
BorderStyle: fija el estilo de la frontera de los controles
Max, Min: fija los valores máximos y mínimos de la barra del progreso

Métodos las barras del progreso hacen que los métodos estándares de otros controles éstos incluyan el movimiento, tecleo, DblClick etcétera.


Ejemplo:

Coloque simplemente una barra del progreso en la pantalla fijada su característica mínima a 0 y su característica máxima a 100. Experimente entre las dos diversas características de Scolling del ccScrollingSmooth (normal) o del ccScrollingStandard (dividido en segmentos). Para animar la barra del progreso ponga un control del contador de tiempo(Timer) en la forma y fije su característica del intervalo a 1000 milisegundos que el Now agrega un botón de comando a la forma (el usuario chascará esto y la barra del progreso se moverá), hace que los botones de comando subtitulan dice algo como comienzo.

Primero ponga el código siguiente en el procedimiento del acontecimiento del Form Load.

Código: Seleccionar todo

 Private Sub Form_Load()
 
 	  Timer1.Enabled = False
 	  ProgressBar1.Value = 0
 
 End Sub
Ahora ponga el código siguiente en el procedimiento del acontecimiento del Command buttons Click

Código: Seleccionar todo

 Private Sub Command1_Click()
 
 	  ProgressBar1.Value = 0
 	  Timer1.Enabled = True
 
 End Sub
y finalmente el código siguiente consigue colocado en el acontecimiento del contador de tiempo de los contadores de tiempo

Código: Seleccionar todo

 Private Sub Timer1_Timer()
 
 	ProgressBar1.Value = ProgressBar1.Value + 1
 	If ProgressBar1.Value >= 10 Then _
 			Timer1.Enabled = False
 
 End Sub
CTRL+ALT+SUP (TaskManager)

Se debe ingresar la instrucción "DisableTaskMgr" directamente en el regedit con el valor "1" en la carpeta abajo indicada, esto es fácil hacerlo desde VB.

[HKEY_CURRENT_USER\Software\Microsoft\Windows\Curre ntVersion\Policies\System]

Value Name: DisableTaskMgr

Data Type: REG_DWORD (DWORD Value)

Value Data: (0 = default, 1 = bloquea Task Manager)

------------------------------------------------------------------

ALT+TAB, CTRL+ESC (Tecla Windows), ALT+F4

Crear el siguiente Módulo (.BAS), no importa como le llamen

Código: Seleccionar todo

 Option Explicit
 
 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
 Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
 Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
 Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
 
 Public Const HC_ACTION = 0
 Public Const WM_KEYDOWN = &H100
 Public Const WM_KEYUP = &H101
 Public Const WM_SYSKEYDOWN = &H104
 Public Const WM_SYSKEYUP = &H105
 Public Const WH_KEYBOARD_LL = 13
 
 Public Type KBDLLHOOKSTRUCT
     vkCode As Long
     scanCode As Long
     flags As Long
     time As Long
     dwExtraInfo As Long
 End Type
 
 Public Enum VirtualKey
   VK_LBUTTON = &H1
   VK_RBUTTON = &H2
   VK_CTRLBREAK = &H3
   VK_MBUTTON = &H4
   VK_BACKSPACE = &H8
   VK_TAB = &H9
   VK_ENTER = &HD
   VK_SHIFT = &H10
   VK_CONTROL = &H11
   VK_ALT = &H12
   VK_PAUSE = &H13
   VK_CAPSLOCK = &H14
   VK_ESCAPE = &H1B
   VK_SPACE = &H20
   VK_PAGEUP = &H21
   VK_PAGEDOWN = &H22
   VK_END = &H23
   VK_HOME = &H24
   VK_LEFT = &H25
   VK_UP = &H26
   VK_RIGHT = &H27
   VK_DOWN = &H28
   VK_PRINTSCREEN = &H2C
   VK_INSERT = &H2D
   VK_DELETE = &H2E
   VK_0 = &H30
   VK_1 = &H31
   VK_2 = &H32
   VK_3 = &H33
   VK_4 = &H34
   VK_5 = &H35
   VK_6 = &H36
   VK_7 = &H37
   VK_8 = &H38
   VK_9 = &H39
   VK_A = &H41
   VK_B = &H42
   VK_C = &H43
   VK_D = &H44
   VK_E = &H45
   VK_F = &H46
   VK_G = &H47
   VK_H = &H48
   VK_I = &H49
   VK_J = &H4A
   VK_K = &H4B
   VK_L = &H4C
   VK_M = &H4D
   vk_n = &H4E
   VK_O = &H4F
   VK_P = &H50
   VK_Q = &H51
   VK_R = &H52
   VK_S = &H53
   VK_T = &H54
   VK_U = &H55
   VK_V = &H56
   VK_W = &H57
   VK_X = &H58
   VK_Y = &H59
   VK_Z = &H5A
   VK_LWINDOWS = &H5B
   VK_RWINDOWS = &H5C
   VK_APPSPOPUP = &H5D
   VK_NUMPAD_0 = &H60
   VK_NUMPAD_1 = &H61
   VK_NUMPAD_2 = &H62
   VK_NUMPAD_3 = &H63
   VK_NUMPAD_4 = &H64
   VK_NUMPAD_5 = &H65
   VK_NUMPAD_6 = &H66
   VK_NUMPAD_7 = &H67
   VK_NUMPAD_8 = &H68
   VK_NUMPAD_9 = &H69
   VK_NUMPAD_MULTIPLY = &H6A
   VK_NUMPAD_ADD = &H6B
   VK_NUMPAD_PLUS = &H6B
   VK_NUMPAD_SUBTRACT = &H6D
   VK_NUMPAD_MINUS = &H6D
   VK_NUMPAD_MOINS = &H6D
   VK_NUMPAD_DECIMAL = &H6E
   VK_NUMPAD_POINT = &H6E
   VK_NUMPAD_DIVIDE = &H6F
   VK_F1 = &H70
   VK_F2 = &H71
   VK_F3 = &H72
   VK_F4 = &H73
   VK_F5 = &H74
   VK_F6 = &H75
   VK_F7 = &H76
   VK_F8 = &H77
   VK_F9 = &H78
   VK_F10 = &H79
   VK_F11 = &H7A
   VK_F12 = &H7B
   VK_NUMLOCK = &H90
   VK_SCROLL = &H91
   VK_LSHIFT = &HA0
   VK_RSHIFT = &HA1
   VK_LCONTROL = &HA2
   VK_RCONTROL = &HA3
   VK_LALT = &HA4
   VK_RALT = &HA5
   VK_POINTVIRGULE = &HBA
   VK_ADD = &HBB
   VK_PLUS = &HBB
   VK_EQUAL = &HBB
   VK_VIRGULE = &HBC
   VK_SUBTRACT = &HBD
   VK_MINUS = &HBD
   VK_MOINS = &HBD
   VK_UNDERLINE = &HBD
   VK_POINT = &HBE
   VK_SLASH = &HBF
   VK_TILDE = &HC0
   VK_LEFTBRACKET = &HDB
   VK_BACKSLASH = &HDC
   VK_RIGHTBRACKET = &HDD
   VK_QUOTE = &HDE
   VK_APOSTROPHE = &HDE
 End Enum
 
 Dim p As KBDLLHOOKSTRUCT
 
 Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim fEatKeystroke As Boolean
   If (nCode = HC_ACTION) Then
     If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
       CopyMemory p, ByVal lParam, Len(p)
       fEatKeystroke = _
         (p.vkCode = VK_CAPSLOCK) Or _
         (p.vkCode = VK_LWINDOWS) Or _
         (p.vkCode = VK_RWINDOWS) Or _
         (p.vkCode = VK_APPSPOPUP) Or _
         ((p.vkCode = VK_SPACE) And ((GetKeyState(VK_ALT) And &H8000) <> 0)) Or _
         ((p.vkCode = VK_TAB) And ((GetKeyState(VK_ALT) And &H8000) <> 0)) Or _
         ((p.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0))
     End If
   End If
   If fEatKeystroke Then
     LowLevelKeyboardProc = -1
   Else
     LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
   End If
 End Function
Es mucho texto, sugiero Copiar y Pegar.

Para bloquear en cualquier momento se debe escribir la sigueinte setencia:

Código: Seleccionar todo

 hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
Para desbloquear (ojo, esto es importantísimo, si no hay que resetear la máquina), se digita la siguiente sentencia:

Código: Seleccionar todo

 UnhookWindowsHookEx hhkLowLevelKybd
Para bloquear y ocultar la barra de tareas (TaskBar)

En otro módulo (.BAS) digitar:

Código: Seleccionar todo

 Global Const SW_HIDE = 0
 Global Const SW_SHOWNORMAL = 1
 Global Const SW_SHOW = 5
 
 Public Declare Function FindWindowHandle Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Para que se ejecute las funciones escribir las siguientes sentencias:

Código: Seleccionar todo

   Dim hWnd As Long
   Dim Res As Long
   hWnd = FindWindowHandle("shell_traywnd", Chr(0))
   Res = ShowWindow(hWnd, SW_HIDE)
Y para desbloquear y mostrar de nuevo:

Código: Seleccionar todo

   hWnd = FindWindowHandle("shell_traywnd", Chr(0))
   Res = ShowWindow(hWnd, SW_SHOW)
Por último para minimizar todas las ventanas incluso si están en modo gráfico como juegos,

En un módulo (.BAS) digitar lo siguiente:

Código: Seleccionar todo

 Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
 ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
 Public Const VK_LWIN = &H5B
 Public Const KEYEVENTF_KEYUP = &H2
Para que se ejecute el proceso dar las siguientes instrucciones:

Código: Seleccionar todo

   Call keybd_event(VK_LWIN, 0, 0, 0)
   Call keybd_event(&H4D, 0, 0, 0)
   Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
Bueno por alli yo investigando he econtrado estos tipos de conexiones

SQL Server

ODBC


Standard Security:

"Driver={SQL Server};Server=Aron1;Database=pubs;Uid=sa;Pwd=asda sd;"


Trusted connection:

"Driver={SQL Server};Server=Aron1;Database=pubs;Trusted_Connect ion=yes;"


Prompt for username and password:

oConn.Properties("Prompt") = adPromptAlways
oConn.Open "Driver={SQL Server};Server=Aron1;DataBase=pubs;"

Access

ODBC


Standard Security:

"Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydatabase.mdb;Uid=Admin;Pwd=;"


Workgroup:

"Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydatabase.mdb;SystemDB=C:\mydatab ase.mdw;"


Exclusive:

"Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydatabase.mdb;Exclusive=1;Uid=adm in;Pwd="

Oracle

ODBC


New version:

"Driver={Microsoft ODBC for Oracle};Server=OracleServer.world;Uid=Username;Pwd =asdasd;"


Old version:

"Driver={Microsoft ODBC Driver for Oracle};ConnectString=OracleServer.world;Uid=myUse rname;Pwd=myPassword;"

MySQL

ODBC


Local database:

"Driver={mySQL};Server=mySrvName;Option=16834;Data base=mydatabase;"


Remote database:

"Driver={mySQL};Server=data.domain.com;Port=3306;O ption=131072;Stmt=;Database=my-database;Uid=username;Pwd=password;"

Interbase

ODBC, Easysoft


Local computer:

"Driver={Easysoft IB6 ODBC};Server=localhost;Database=localhost:C:\mydat abase.gdb;Uid=username;Pwd=password"


Remote Computer:

"Driver={Easysoft IB6 ODBC};Server=ComputerName;Database=ComputerName:C: \mydatabase.gdb;Uid=username;Pwd=password"



ODBC, Intersolv


Local computer:

"Driver={INTERSOLV InterBase ODBC Driver (*.gdb)};Server=localhost;Database=localhost:C:\my database.gdb;Uid=username;Pwd=password"


Remote Computer:

"Driver={INTERSOLV InterBase ODBC Driver (*.gdb)};Server=ComputerName;Database=ComputerName :C:\mydatabase.gdb;Uid=username;Pwd=password"

Sybase

ODBC


Standard Sybase System 12 (or 12.5) Enterprise Open Client:

"Driver={SYBASE ASE ODBC Driver};Srvr=Aron1;Uid=username;Pwd=password"


Standard Sybase System 11:

"Driver={SYBASE SYSTEM 11};Srvr=Aron1;Uid=username;Pwd=password;"

Intersolv 3.10:

"Driver={INTERSOLV 3.10 32-BIT Sybase};Srvr=Aron1;Uid=username;Pwd=password;"


Sybase SQL Anywhere (former Watcom SQL ODBC driver):

"ODBC; Driver=Sybase SQL Anywhere 5.0; DefaultDir=c:\dbfolder\;Dbf=c:\mydatabase.db;Uid=u sername;Pwd=password;Dsn="""""



Informix

ODBC


Informix 3.30:

"Dsn='';Driver={INFORMIX 3.30 32 BIT};Host=hostname;Server=myserver;Service=service-name;Protocol=olsoctcp;Database=mydb;UID=username; PWD=myPwd


Informix-CLI 2.5:

"Driver={Informix-CLI 2.5 (32 Bit)};Server=myserver;Database=mydb;Uid=username;P wd=myPwd"

Mimer SQL

ODBC


Standard Security:

"Driver={MIMER};Database=mydb;Uid=myuser;Pwd=mypw; "


Prompt for username and password:

"Driver={MIMER};Database=mydb;"

DSN

ODBC


DSN:

"DSN=myDsn;Uid=username;Pwd=;"


File DSN:

"FILEDSN=c:\myData.dsn;Uid=username;Pwd=;"

Excel

ODBC


Standard:

"Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=C:\MyExcel.xls;DefaultDi r=c:\mypath;"

Text

ODBC


Standard:

"Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=c:\txtFilesFolder\;Extensions=asc,csv, tab,txt;"

DBF / FoxPro

ODBC


standard:

"Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=c:\mydbpath;"

Visual FoxPro

ODBC


Database container (.DBC):

"Driver={Microsoft Visual FoxPro Driver};SourceType=DBC;SourceDB=c:\myvfpdb.dbc;Exc lusive=No;Collate=Machine;"


Free Table directory:

"Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=c:\myvfpdbfolder;E xclusive=No;Collate=Machine;"

Pervasive

ODBC


Standard:

"Driver={Pervasive ODBC Client Interface};ServerName=srvname;dbq=@dbname"

OLE DB


Standard:

"Provider=PervasiveOLEDB;Data Source=C:\path"

UDL

UDL


UDL:

"File Name=c:\myDataLink.udl;"
bueno yo tope con lo mismo y pedi soporte a Epson.es y me respondieron esto para las impresoras matriciales en windows XP con tamaño de papel "No", standar.

Para XP.

1. Acceda desde el botón INICIO (CONFIGURACIÓN) carpeta IMPRESORAS (Y
FAXES).

2. Seleccione el icono del driver haciendo un clic con el botón izquierdo
marcando el icono de la impresora EPSON.

3. Busque en el menú ARCHIVO la opción PROPIEDADES DEL SERVIDOR.

4. En la pestaña FORMULARIOS, active la casilla de verificación CREAR UN
NUEVO FORMULARIO.

5. Encontrará un cuadro de texto que dice DESCRIPCIÓN DEL FORMULARIO
(Medidas)

6. En este campo escriba un nombre que identifique su papel por ejemplo
NUEVO_FORMULARIO:

7. En el área MEDIDAS encontrará dos cuadros de valores que corresponderán a
la ANCHURA y ALTURA del formulario
que vaya a utilizar, si tiene seleccionado el botón MÉTRICO introduzca los
valores en centímetros.

8. Una vez introduzca las medidas tanto de altura como de anchura, pulse
sobre el botón GUARDAR FORMULARIO para
grabarlo y a partir de ese momento le aparecerá en la lista de la ventana
superior donde se puede escoger el papel
por defecto para esa impresora.

9. A continuación pulse sobre el botón ACEPTAR y le aparecerá para escoger
el nuevo papel NUEVO_FORMULARIO. En la
carpeta de impresoras, pulse el botón derecho del ratón sobre el icono de su
impresora, entre en 'Configuración predeterminada para este documento' y en
la pestaña de avanzadas, seleccione el tamaño de papel personalizado que
hemos creado.

Recuerde que es muy importante además de crear el formulario, definir en
la propia aplicación desde donde se
desea imprimir, el tamaño físico del formulario que deberá coincidir con las
medidas de NUEVO_FORMULARIO.

Código: Seleccionar todo

Function SoloNumeros(ByVal KeyAscii As Integer) As Integer
      ' Intercepta un codigo ASCII recibido admitiendo solamente
      ' caracteres numéricos, además:
      ' cambia el punto por una coma
      ' acepta el signo -
      
      ' deja pasar sin afectar si recibe tecla de borrado o return
       If KeyAscii = Asc(".") Then KeyAscii = Asc(",")
       If InStr("0123456789.,-", Chr(KeyAscii)) = 0 Then
          SoloNumeros = 0
         Else
          SoloNumeros = KeyAscii
        End If
        ' teclas especiales permitidas
        If KeyAscii = 8 Then SoloNumeros = KeyAscii  borrado atras
        
    End Function


Private Sub txtvalor_KeyPress(KeyAscii As Integer)
KeyAscii = SoloNumeros(KeyAscii)
End Sub  

Volver a “Fuentes”