Access y VBA - Instalar, leer fuente de windows(codigo barras)

Instalar, leer fuente de windows(codigo barras)

Impreso de: Foro de Access y VBA
Categoría: Access y VBA
Nombre del foro: Access y VBA
Descripción del foro: Foro de programacion en Access (Con código y sin código)
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=84646
Fecha de impresión: 26/Marzo/2026 a las 22:33

Tema: Instalar, leer fuente de windows(codigo barras)

Publicado por: rokoko
Asunto: Instalar, leer fuente de windows(codigo barras)
Fecha de publicación: 15/Agosto/2019 a las 17:45

Hola

Hay alguna forma desde vba que access lea la fuente de codigo de barras sin tenerla instalada??

El objetivo es que lo lea desde una carpeta que yo designe.

Tambien he probado desde vba a copiar la fuente a la carpeta windows\Fonts pero no lo hace e instala.

Saludos

Respuestas:

Publicado por: rokoko
Fecha de publicación: 15/Agosto/2019 a las 18:02

Algo he conseguido buscando en google esto AddFontResource Lib "gdi32"

https://www.lawebdelprogramador.com/foros/Visual-Basic/8535-Como-poner-fuentes-de-letra-en-Vb.html" rel="nofollow - https://www.lawebdelprogramador.com/foros/Visual-Basic/8535-Como-poner-fuentes-de-letra-en-Vb.html

http://www.pablin.com.ar/computer/programa/vb/agregttf.htm" rel="nofollow - http://www.pablin.com.ar/computer/programa/vb/agregttf.htm

http://www.freevbcode.com/ShowCode.asp?ID=1945" rel="nofollow - http://www.freevbcode.com/ShowCode.asp?ID=1945

Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long

Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long

Instala la fuente

Dim result As Long

result = AddFontResource("C:\Users\Norco\Desktop\BD16 Biblioteca\IDAutomationHC39M.ttf")

Desinstala la fuente

Dim result As Long

result = RemoveFontResource("C:\Users\Norco\Desktop\BD16 Biblioteca\IDAutomationHC39M.ttf")

Pero lo ideal seria que lo leiese desde la carpeta que yo quiera, ademas de la forma anterior si no esres administrador dudo mucho que lo instale.

Lo curioso de usar el sistema expuesto es que en la carpeta de las fuentes no sale, pero esta instalado.

Publicado por: rokoko
Fecha de publicación: 25/Agosto/2019 a las 15:13

Algo he conseguido.

Si ulilizo una fuente instalada no hay problema.

He encontrado este codigo que funciona, siempre que no esten los asteriscos en el codigo de barras. Si pongo asteriscos me lo saca asi con este simbolo ( por ejemplo el codigo 000002 sale (000002( no tengo ni idea por que.... El codigo del asterisco por lo que he visto es el correcto, lo remarco en el codigo. A alguno se os ocurre el porque???

Public Function FC_barcode3of9(ByVal strWord As String, _

ByVal strObj As Object)

Dim x As Integer

Dim y As Integer

Dim z As Integer

Dim pos As Integer

Dim Barcode As String

Dim Cur As String

Dim CurVal As Integer

Dim BC(0 To 43) As String

BC(0) = "000110100" '0

BC(1) = "100100001" '1

BC(2) = "001100001" '2

BC(3) = "101100000" '3

BC(4) = "000110001" '4

BC(5) = "100110000" '5

BC(6) = "001110000" '6

BC(7) = "000100101" '7

BC(8) = "100100100" '8

BC(9) = "001100100" '9

BC(10) = "100001001" 'A

BC(11) = "001001001" 'B

BC(12) = "101001000" 'C

BC(13) = "000011001" 'D

BC(14) = "100011000" 'E

BC(15) = "001011000" 'F

BC(16) = "000001101"

BC(17) = "100001100"

BC(18) = "001001100"

BC(19) = "000011100"

BC(20) = "100000011"

BC(21) = "001000011"

BC(22) = "101000010"

BC(23) = "000010011"

BC(24) = "100010010"

BC(25) = "001010010"

BC(26) = "000000111"

BC(27) = "100000110"

BC(28) = "001000110"

BC(29) = "000010110"

BC(30) = "110000001"

BC(31) = "011000001"

BC(32) = "111000000" 'W

BC(33) = "010010001" 'X

BC(34) = "110010000" 'Y

BC(35) = "011010000" 'Z

BC(36) = "010000101" '-

BC(37) = "110000100" '.

BC(38) = "011000100" '<spc>

BC(39) = "010101000" '$

BC(40) = "010100010" '/

BC(41) = "010001010" '+

BC(42) = "000101010" '%

BC(43) = "010010100" '* (used for start/stop character only)

strObj.Cls

pos = 20 '10

Barcode = UCase(strWord)

'Add Start & Stop characters?

'If Check1.value Then Barcode = "*" & Barcode & "*"

'If Check1.Value Then

Barcode = "*" & Barcode & "*"

'Generate Barcode

For x = 1 To Len(Barcode)

Cur = Mid$(Barcode, x, 1)

Select Case Cur

Case "0" To "9"

CurVal = Val(Cur)

Case "A" To "Z"

CurVal = Asc(Cur) - 55

Case "-"

CurVal = 36

Case "."

CurVal = 37

Case " "

CurVal = 38

Case "$"

CurVal = 39

Case "/"

CurVal = 40

Case "+"

CurVal = 41

Case "%"

CurVal = 42

Case "*"

CurVal = 43

Case Else 'oops!

strObj.Cls

strObj.Print Cur & " is Invalid"

Exit Function

End Select

For y = 1 To 9

If y / 2 = Int(y / 2) Then

'SPACE

pos = pos + 1 + (3 * Val(Mid$(BC(CurVal), y, 1)))

Else

'BAR

For z = 1 To 1 + (3 * Val(Mid$(BC(CurVal), y, 1)))

strObj.Line (pos, 1)-(pos, 50) ''strObj.Line (pos, 1)-(pos, 50)

pos = pos + 1

Next z

End If

Next y

pos = pos + 1 'make inter-character gap (ie: 1 narrow space)

Next x

'Add Label?

'If Check2.value = True Then 'false

' strObj.CurrentX = Len(Barcode) * 7 'kinda center

' strObj.Print Barcode

'End If

End Function 'BC

Publicado por: MexMan70
Fecha de publicación: 27/Agosto/2019 a las 17:00

Hola Rokoko, no he entendido tu pregunta. Acaso te refieres a que Acces verifique si esta instalada una tipografía (fuenre) y en caso de no existir que la instalé?
O acaso simplemente deseas leer los "palitos" ?

Saludos !

-------------
OneDrive: http://sdrv.ms/Vk6eJd

Publicado por: rokoko
Fecha de publicación: 27/Agosto/2019 a las 23:01

Lo que quiero es tener codigo de barras pero que no lo coja de una fuente(para no tener obligación de tenerla instalada). Que sea mediante codigo vba.

Saludos

Publicado por: rokoko
Fecha de publicación: 02/Octubre/2019 a las 13:16

Se puede cerrar. Lo he solucionado como el tercer mensaje quitando los asteriscos.