Option Compare Database
Option Explicit
Public Sub lstAlign(lstBox As ListBox, lstColumn As Long, ncampos As Long)
'-----------------------------------------------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/vba-alinear-campo-de-listbox-a-la-derecha/
'-----------------------------------------------------------------------------------------------------------------------------------------------
' Título : lstAlign
' Autor : Luis Viadel | luisviadel@access-global.net
' Creado : 15/06/2023
' Propósito : alinear a la derecha las columnas numéricas de un listbox
' Más información : https://access-global.net/aprende-wizhook-con-colin-riddington/
' https://access-global.net/vba-crear-y-manipular-una-tabla-en-tiempo-de-ejecucion/
'-----------------------------------------------------------------------------------------------------------------------------------------------
' Test : para adaptar este código en tu aplicación puedes basarte en este procedimiento test. Copiar el bloque siguiente al
' portapapeles y pega en el editor de VBA. Adáptalo con tus datos y pulsa F5 para ver su funcionamiento.
'
'Public Sub Micampo_AfterUpdate()
'
' lstAlign Me.MiListBox, nColumna, Me.MiListBox.ColumnCount
'
'End Sub
'-----------------------------------------------------------------------------------------------------------------------------------------------
Dim sizeColumns As String, strSQL As String, strSQL1 As String
Dim sizeCol As Long, valItem As Long
Dim matWidth, matItems
Dim num As Integer, intWhere As Integer
Dim tbl As Object
Dim dbs As DAO.Database
Dim rstTable As DAO.Recordset
Dim ajust As Long
Dim spcBlank As Long
Dim wzFontName As String
Dim wzSize As Long
Dim wzWeight As Long
Dim wzItalic As Boolean
Dim wzUnderline As Boolean
Dim wzCch As Long
Dim wzCaption As String
Dim wzMaxWidthCch As Long
Dim wzdx As Long
Dim wzdy As Long
'Para poder utilizar de nuevo la tabla temporal, debemos liberar el listbox
lstBox.RowSource = ""
'Comprobamos si la tabla temporal ya ha sido creada para borrarla
'Este código es necesario para la primera vez
For Each tbl In CurrentData.AllTables
If tbl.name = "tempTable" Then
DoCmd.DeleteObject acTable, "tempTable"
End If
Next tbl
'Traemos las dimensiones de las columnas
sizeColumns = lstBox.ColumnWidths
'Grabamos en una matriz las dimensiones una a una
matWidth = Split(sizeColumns, ";")
'Recorremos la matriz buscando el tamaño de la columna solicitada
For num = 0 To UBound(matWidth)
If num = lstColumn Then
sizeCol = matWidth(lstColumn)
End If
Next
'ajust es una variable de ajuste porque los cálculos no son exactos.
'Se obtiene realizando pruebas, no tiene ningún fundamento más que ajustar los resultados
If sizeCol > 500 And sizeCol < 1000 Then
ajust = 0
End If
If sizeCol > 1000 And sizeCol < 2000 Then
ajust = 4
End If
If sizeCol > 2000 And sizeCol > 3000 Then
ajust = 6
End If
If sizeCol > 3000 Then
ajust = 7
End If
'Creamos una tabla temporal donde guardamos los datos del listbox convertidos en texto (véase Destello 191)
For num = 1 To lstBox.ColumnCount
strSQL = strSQL & " campo" & num & " CHAR,"
Next
strSQL = "CREATE TABLE tempTable (" & Left(strSQL, Len(strSQL) - 1) & ");"
Set dbs = CurrentDb
dbs.Execute strSQL
'Rellena la nueva tabla con los datos del listbox
strSQL = "SELECT idprodut, produtcod, produtnom, precio, activo FROM productos;"
For num = 1 To ncampos
If num = 1 Then
strSQL1 = "campo" & num & ", "
ElseIf num = ncampos Then
strSQL1 = strSQL1 & "campo" & num
Else
strSQL1 = strSQL1 & "campo" & num & ", "
End If
Next num
dbs.Execute " INSERT INTO tempTable (" & strSQL1 & ") " & strSQL
Set dbs = Nothing
'Otras posibilidades que mejorarían el ejemplo
'1. Recorremos la tabla para comprobar los decimales en los números (Se podrían unificar los números)
'2. A los campos moneda les podemos incorporar el símbolo de moneda
'...
'Ordenamos el campo a la derecha o la izquierda según la decisión del usuario
'Calculamos cuantos Twips tiene un carácter en blanco
On Error Resume Next
WizHook.key = 51488399
'Para ordenar, rellenaremos de espacios en blanco el campo
wzFontName = lstBox.FontName
wzSize = lstBox.FontSize
wzWeight = lstBox.FontWeight
wzItalic = lstBox.FontItalic
wzUnderline = lstBox.FontUnderline
wzCaption = " "
WizHook.TwipsFromFont wzFontName, wzSize, wzWeight, _
wzItalic, wzUnderline, wzCch, _
wzCaption, wzMaxWidthCch, _
wzdx, wzdy
strSQL = "Campo" & lstColumn + 1
Set rstTable = CurrentDb.OpenRecordset("SELECT " & strSQL & " FROM tempTable")
Do Until rstTable.EOF
rstTable.Edit
spcBlank = (sizeCol / wzdx) - (2 * (Len(c(rstTable.Fields(strSQL))))) - ajust
rstTable.Fields(strSQL).value = RTrim(Space(spcBlank) & Trim(rstTable.Fields(strSQL)))
rstTable.Update
rstTable.MoveNext
Loop
Set dbs = Nothing
lstBox.RowSource = "SELECT * FROM temptable"
End Sub
Para Luis Viadel:
Luís: Como de costumbre trabajando para los demás con muy buenos ejemplos.
En éste de alinear datos campos numéricos a la derecha hay un pequeño inconveniente con el Código citado y el que hay en La BBDD del ejemplo. Después de ver tu Video lo he detectado. Lo comento por si alguien se baja el Ejemplo y no le funciona.
Linea:
spcBlank = (sizeCol / wzdx) – (2 * (Len(c(rstTable.Fields(strSQL))))) – ajust ‘JTJ: Esta era la línea Original del Código. Da ERROR
Debe ser:
spcBlank = (sizeCol / wzdx) – (2 * (Len(Trim(rstTable.Fields(strSQL))))) – ajust ”JTJ: Esta es la línea que se visualiza en el Video. No da ERROR.
De otro lado, he intentado mirar las Referencias y Propiedades de Proyecto y me pide una contraseña.
¿Es pedir mucho si te “pido” que me la facilites?. Muy agradecido si lo haces, y si no puedes pues nada.
Un cordial saludo >> Jacinto
Hola Jacinto, gracias por corregir el error. Es un error de transcripción porque el código estaba probado como se ve en el vídeo.
Respecto a la contraseña no es posible. Todo el código que subimos está libre y a disposición del que lo quiera.
Si puedo hacer algo más, no dudes en pedirlo.
Saludos.
Hola Jacinto, creo que no me he explicado bien. Nosotros NUNCA ponemos contraseñas, por lo que me resulta muy extraño que la tenga. Además del ejemplo, publicamos el código. No tendría sentido enviar un ejemplo con contraseña. He comprobado el fichero que hemos subido y no hay contraseña. Creo que no te entiendo.
Saludos
Hola Luis: Lamento consumir tu tiempo en algo menor, pero ciertamente en el fichero de descarga y una vez descomprimido. El código se ve y se puede editar.
Pero: Si pulso en el editor >> Herramientas >> Referencias, pide contraseña.
Igualmente en Herramientas>> Propiedades de….., pide contraseña.
Un cordial saludo >> Jacinto.
PD: Me leeré con atención vuestra sección de colaboración por si puedo aportar algo.
5 Comments
Para Luis Viadel:
Luís: Como de costumbre trabajando para los demás con muy buenos ejemplos.
En éste de alinear datos campos numéricos a la derecha hay un pequeño inconveniente con el Código citado y el que hay en La BBDD del ejemplo. Después de ver tu Video lo he detectado. Lo comento por si alguien se baja el Ejemplo y no le funciona.
Linea:
spcBlank = (sizeCol / wzdx) – (2 * (Len(c(rstTable.Fields(strSQL))))) – ajust ‘JTJ: Esta era la línea Original del Código. Da ERROR
Debe ser:
spcBlank = (sizeCol / wzdx) – (2 * (Len(Trim(rstTable.Fields(strSQL))))) – ajust ”JTJ: Esta es la línea que se visualiza en el Video. No da ERROR.
De otro lado, he intentado mirar las Referencias y Propiedades de Proyecto y me pide una contraseña.
¿Es pedir mucho si te “pido” que me la facilites?. Muy agradecido si lo haces, y si no puedes pues nada.
Un cordial saludo >> Jacinto
Hola Jacinto, gracias por corregir el error. Es un error de transcripción porque el código estaba probado como se ve en el vídeo.
Respecto a la contraseña no es posible. Todo el código que subimos está libre y a disposición del que lo quiera.
Si puedo hacer algo más, no dudes en pedirlo.
Saludos.
Luis: Gracias por contestar.
Lo de la contraseña era mera curiosidad y ya imaginaba que si la tenía era por alguna razón.
Un cordial saludo >> Jacinto
Hola Jacinto, creo que no me he explicado bien. Nosotros NUNCA ponemos contraseñas, por lo que me resulta muy extraño que la tenga. Además del ejemplo, publicamos el código. No tendría sentido enviar un ejemplo con contraseña. He comprobado el fichero que hemos subido y no hay contraseña. Creo que no te entiendo.
Saludos
Hola Luis: Lamento consumir tu tiempo en algo menor, pero ciertamente en el fichero de descarga y una vez descomprimido. El código se ve y se puede editar.
Pero: Si pulso en el editor >> Herramientas >> Referencias, pide contraseña.
Igualmente en Herramientas>> Propiedades de….., pide contraseña.
Un cordial saludo >> Jacinto.
PD: Me leeré con atención vuestra sección de colaboración por si puedo aportar algo.