** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Ayuda con tamaño letra vba
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoAyuda con tamaño letra vba

 Responder Responder
Autor
Mensaje
 Valoración: Valorar tema: 1 Votos, Promedio 3.00  Tema Buscar Tema Buscar  Opciones del Tema Opciones del Tema
DRUIDINN Ver desplegable
Nuevo
Nuevo


Unido: 21/Febrero/2017
Localización: ARGENTINA
Estado: Sin conexión
Puntos: 22
Enlace directo a este mensaje Tema: Ayuda con tamaño letra vba
    Enviado: 17/Marzo/2017 a las 23:06
Buenas tardes gente!!!!!!! Les cuento, tuve un inconveniente para poder meter un texto dentro de un determinado campo y en otro tema, me enviaron varias respuestas con codigo en VBA el cual al implementarlo funciono barbaro, pero por no saber VBA no se como poder limitar el codigo para el caso de que sean pocas letras o sea, si el texto es poco, que no se agrande tanto la letra... no se hacerlo... ALGUNO SERIA TAN AMABLE DE REVISAR EL CODIGO PARA LIMITARLO EN TAMAÑO?, Aca les pongo el texto, y DE ANTEMANO, MUCHAS GRACIAS!!!!!!!!!!!!!!ClapClapClap


Private Sub Detalle_Format(Cancel As Integer, FormatCount As Integer)
Dim mtamany As Long
Dim mfont As String
Dim mstring As String
Dim mtam As Long
Dim mtext As Control
Set mtext = Me.nombrecuadrotexto ''''''cambiar por el nombre del control text
mfont = mtext.FontName
mtamany = mtext.Width
mstring = mtext.Value
mtam = 4  'inicio del tamaño
Do While Twipscadena(mstring, mtam, mfont) < mtamany - 15
 mtam = mtam + 1
 
Loop
mtext.FontSize = mtam - 2
End Sub

Private Sub Detalle_Paint()
Dim mtamany As Long
Dim mfont As String
Dim mstring As String
Dim mtam As Long
Dim mtext As Control
Set mtext = Me.nombrecuadrotexto ''''''cambiar por el nombre del control text
mfont = mtext.FontName
mtamany = mtext.Width
mstring = mtext.Value
mtam = 4  'inicio del tamaño
Do While Twipscadena(mstring, mtam, mfont) < mtamany - 15
 mtam = mtam + 1
 
Loop
mtext.FontSize = mtam - 2

End Sub

Private Function Twipscadena(mcamp As String, mtam As Long, mfont As String)
'Adaptado de un código de Juan M. Afán de Ribera ( Happy)
'Calcula la longitud en twips de una cadena en función del tamaño y tipo de fuente
Dim wzWeight As Long
Dim wzItalic As Boolean
Dim wzUnderline As Boolean
Dim wzCch As Long
Dim wzMaxWidthCch As Long
Dim wzdx As Long
Dim wzdy As Long
  WizHook.Key = 51488399
  wzItalic = False
  wzUnderline = False
  WizHook.TwipsFromFont mfont, mtam, wzWeight, wzItalic, wzUnderline, wzCch, mcamp, wzMaxWidthCch, wzdx, wzdy
Twipscadena = wzdx
End Function
Arriba
MexMan70 Ver desplegable
Colaborador
Colaborador


Unido: 17/Julio/2007
Localización: DarkSide
Estado: Sin conexión
Puntos: 9227
Enlace directo a este mensaje Enviado: 17/Marzo/2017 a las 23:12
Para averiguar la longitud de un texto usa la funcion LEN(), si es poca longitud obras en consecuencia. Si deseas sabr mas de la funcion Len() busca en la ayuda de Access. Ejemplo

If Len(Me.ElTexto)>50 Then
   'Expandimos el texto
End If
OneDrive: http://sdrv.ms/Vk6eJd
Arriba
DRUIDINN Ver desplegable
Nuevo
Nuevo


Unido: 21/Febrero/2017
Localización: ARGENTINA
Estado: Sin conexión
Puntos: 22
Enlace directo a este mensaje Enviado: 17/Marzo/2017 a las 23:15
uuuhh... me mataste... jajjajaja.... y donde lo meteria eso? yo copie y pegue este texto y anduvo pero no se programar... podrias agregarlo a eso que mande? perdon, se que quizas pido mucho pero no se como hacerlo... gracias!!!Clap
Arriba
mounir Ver desplegable
Colaborador
Colaborador


Unido: 09/Febrero/2009
Localización: Asturias-España
Estado: Sin conexión
Puntos: 5140
Enlace directo a este mensaje Enviado: 17/Marzo/2017 a las 23:34
Hola!

Donde Pone:

Do While Twipscadena(mstring, mtam, mfont) < mtamany - 15
mtam = mtam + 1
Loop

' prueba con añadir estas líneas o algo parecido:

if mtext.FontSize > 15 then
   mtext.FontSize = 15
else
mtext.FontSize = mtam - 2
end if


End Sub

Editado por mounir - 17/Marzo/2017 a las 23:35
Un Saludo.
Arriba
DRUIDINN Ver desplegable
Nuevo
Nuevo


Unido: 21/Febrero/2017
Localización: ARGENTINA
Estado: Sin conexión
Puntos: 22
Enlace directo a este mensaje Enviado: 17/Marzo/2017 a las 23:47
 asi asi, no me funciono... quizas tenga que hacer algo mas...
Arriba
prga Ver desplegable
Moderador
Moderador


Unido: 16/Noviembre/2004
Localización: España
Estado: Sin conexión
Puntos: 3159
Enlace directo a este mensaje Enviado: 18/Marzo/2017 a las 00:02
Hola.
El siguiente código es un poco más general que el que expuse en su día y pasa por:
En un módulo general colocamos los dos procedimientos siguientes:

Private Function Twipscadena(mcamp As String, mtam As Single, mfont As String) As Long
'Adaptado de un código de Juan M. Afán de Ribera ( Happy)
'Calcula la longitud en twips de una cadena en función del texto y tipo de fuente
Dim wzWeight As Long
Dim wzItalic As Boolean
Dim wzUnderline As Boolean
Dim wzCch As Long
Dim wzMaxWidthCch As Long
Dim wzdx As Long
Dim wzdy As Long
  WizHook.Key = 51488399
  wzItalic = False
  wzUnderline = False
  WizHook.TwipsFromFont mfont, mtam, wzWeight, wzItalic, wzUnderline, wzCch, mcamp, wzMaxWidthCch, wzdx, wzdy
Twipscadena = wzdx
End Function

Public Sub ajustatext(ByRef meucuadretext As Control, Optional tamanyminim As Single = 4, Optional tamanymaxim As Single = 25)
Dim nn As Single
Dim tamanyutil As Long
If meucuadretext.ControlType <> acTextBox Then
   Exit Sub
End If

If Nz(meucuadretext.Value, "") = "" Then
   Exit Sub
End If

tamanyutil = meucuadretext.Width - meucuadretext.LeftMargin - meucuadretext.RightMargin
tamanyutil = tamanyutil - IIf(meucuadretext.BorderWidth = 0, 20, meucuadretext.BorderWidth * 20)

For nn = tamanyminim To tamanymaxim Step 0.5
 If Twipscadena(meucuadretext.Value, nn, meucuadretext.FontName) >= tamanyutil Then
    meucuadretext.FontSize = nn - 0.5
   Exit Sub
 End If
Next

meucuadretext.FontSize = nn - 0.5
End Sub

y en el informe:

Private Sub Detalle_Format(Cancel As Integer, FormatCount As Integer)
Call ajustatext(Me.nombrecuadrotexto,tamañominimoletra,tamañomayorletra)
end sub

Private Sub Detalle_Paint()
Call ajustatext(Me.nombrecuadrotexto,tamañominimoletra,tamañomayorletra)
end sub

El código está puesto a título de ejemplo, está por depurar, optimizar etc etc
Espero que ayude a resolver la duda.
Otra cosa, en el foro hay dos cursos gratuitos de VBA que son casi imprescindibles para entender el código, programarlo y/o modificarlo a las necesidades de cada uno.
Ya comentas.
Un saludo a todos

Arriba
DRUIDINN Ver desplegable
Nuevo
Nuevo


Unido: 21/Febrero/2017
Localización: ARGENTINA
Estado: Sin conexión
Puntos: 22
Enlace directo a este mensaje Enviado: 18/Marzo/2017 a las 01:02
Genio!!!!! Gracias!!!! Tratare de ver como hago esos dos cursos!!! Millon d3 gracias prga!!! Y a todos los que de una u otra forma aportaron a resolverlo!!!!!
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable