• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Thủ Thuật Access

• Trang chủ

  • Thủ Thuật Access
  • Trang chủ
•   Canh giữa theo chiều cao của Textbox trên Form/Report
  

  Viết bởi: ongke0711 04-11-24, 03:43 PM Chuyên mục: Report - Bài trả lời (1)

• Do có nhiều nhu cầu về việc canh giữa text theo chiều cao của TextBox/Label nên tôi chỉnh sửa cái hàm của Leban để các bạn dễ sử dụng.
  - Áp dụng được trên Form và Report.
  - Tương thích với phiên bản Office, Windows 64 bit.
  - Thêm một hàm canh giữa khác đơn giản hơn nhưng chỉ áp dụng cho Report và hàm này không bị lỗi (Error 2100) của Leban khi font size lớn hơn sức chứa của Textbox. 
  
  Link demo: https://www.mediafire.com/file/6xj7lm95s...accdb/file
  (mượn file của bạn Mr.ToaBin)
  
  
  
  
  
  
  * Copy đoạn code này dán vào Module: modTextWidthHeight_VerticallyCenter
  
  
  Mã PHP:

  Option Compare Database
Option Explicit

'***********************************
'*** Code cua leban.com
'***********************************

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const LF_FACESIZE = 32

Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * LF_FACESIZE
End Type

Private Type TEXTMETRIC
    tmHeight As Long
    tmAscent As Long
    tmDescent As Long
    tmInternalLeading As Long
    tmExternalLeading As Long
    tmAveCharWidth As Long
    tmMaxCharWidth As Long
    tmWeight As Long
    tmOverhang As Long
    tmDigitizedAspectX As Long
    tmDigitizedAspectY As Long
    tmFirstChar As Byte
    tmLastChar As Byte
    tmDefaultChar As Byte
    tmBreakChar As Byte
    tmItalic As Byte
    tmUnderlined As Byte
    tmStruckOut As Byte
    tmPitchAndFamily As Byte
    tmCharSet As Byte
End Type

#If VBA7 Or Win64 Then
    Private Declare PtrSafe Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As LongPtr, lpMetrics As TEXTMETRIC) As Long
    Private Declare PtrSafe Function apiCreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
    Private Declare PtrSafe Function apiSelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function apiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function apiMulDiv Lib "kernel32" Alias "MulDiv" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
    Private Declare PtrSafe Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function apiDrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As LongPtr, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Declare PtrSafe Function CreateDCbyNum Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As LongPtr
    Private Declare PtrSafe Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
#Else
    Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long
    Private Declare Function apiCreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
    Private Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Private Declare Function apiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long
    Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function apiMulDiv Lib "kernel32" Alias "MulDiv" (ByVal nNumber As Long,  ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
    Private Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
    Private Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hDC As Long) As Long
    Private Declare Function apiDrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Declare Function CreateDCbyNum Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long  'DEVMODE) As Long
    Private Declare Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hDC As Long) As Long
    Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
#End If


' CONSTANTS
Private Const TWIPSPERINCH = 1440
' Used to ask System for the Logical pixels/inch in X & Y axis
Private Const LOGPIXELSY = 90
Private Const LOGPIXELSX = 88

' DrawText() Format Flags
Private Const DT_TOP = &H0
Private Const DT_LEFT = &H0
Private Const DT_CALCRECT = &H400
Private Const DT_WORDBREAK = &H10
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_EDITCONTROL = &H2000&
Private Const DT_NOCLIP = &H100



' Font stuff
Private Const OUT_DEFAULT_PRECIS = 0
Private Const OUT_STRING_PRECIS = 1
Private Const OUT_CHARACTER_PRECIS = 2
Private Const OUT_STROKE_PRECIS = 3
Private Const OUT_TT_PRECIS = 4
Private Const OUT_DEVICE_PRECIS = 5
Private Const OUT_RASTER_PRECIS = 6
Private Const OUT_TT_ONLY_PRECIS = 7
Private Const OUT_OUTLINE_PRECIS = 8

Private Const CLIP_DEFAULT_PRECIS = 0
Private Const CLIP_CHARACTER_PRECIS = 1
Private Const CLIP_STROKE_PRECIS = 2
Private Const CLIP_MASK = &HF
Private Const CLIP_LH_ANGLES = 16
Private Const CLIP_TT_ALWAYS = 32
Private Const CLIP_EMBEDDED = 128

Private Const DEFAULT_QUALITY = 0
Private Const DRAFT_QUALITY = 1
Private Const PROOF_QUALITY = 2

Private Const DEFAULT_PITCH = 0
Private Const FIXED_PITCH = 1
Private Const VARIABLE_PITCH = 2

Private Const ANSI_CHARSET = 0
Private Const DEFAULT_CHARSET = 1
Private Const SYMBOL_CHARSET = 2
Private Const SHIFTJIS_CHARSET = 128
Private Const HANGEUL_CHARSET = 129
Private Const CHINESEBIG5_CHARSET = 136
Private Const OEM_CHARSET = 255
'

Public Function fTextHeight(ctl As Control, _
        Optional ByVal sText As String = "", _
        Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
        Optional TotalLines As Long = 0, _
        Optional TwipsPerPixel As Long = 0) As Long
    
    On Error Resume Next
    
    ' Call our function to calculate TextHeight
    ' If blWH=TRUE then we are TextHeight
    fTextHeight = fTextWidthOrHeight(ctl, True, _
        sText, HeightTwips, WidthTwips, TotalLines, TwipsPerPixel)
    
End Function


Public Function fTextWidth(ctl As Control, _
        Optional ByVal sText As String = "", _
        Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
        Optional TotalLines As Long = 0, _
        Optional TwipsPerPixel As Long = 0) As Long
    
    On Error Resume Next
    
    ' If blWH=FALSE then we are TextWidth
    ' Call our function to calculate TextWidth
    fTextWidth = fTextWidthOrHeight(ctl, False, _
        sText, HeightTwips, WidthTwips, TotalLines, TwipsPerPixel)
    
End Function


Public Function fTextWidthOrHeight(ctl As Control, ByVal blWH As Boolean, _
        Optional ByVal sText As String = "", _
        Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
        Optional TotalLines As Long = 0, _
        Optional TwipsPerPixel As Long = 0) As Long
    
    'Name                  FUNCTION() fTextWidthOrHeight
    '
    'Purpose:              Returns the Height or Width needed to
    '                      display the contents of the Control passed
    '                      to this function. This function
    '                      uses the Control's font attributes to build
    '                      a Font for the required calculations.
    '
    '                      This function replaces the Report object's TextHeight
    '                      and TextWidth methods which only work for a single line of text.
    '                      This function works with multiple lines of text and
    '                      also with both Forms and Reports.
    '
    'Version:              4.1
    '
    'Calls:                Text API stuff. DrawText performs the actual
    '                      calculation to determine Control Height.
    '
    'Returns:              Height or width of Control in TWIPS required
    '                      to display current contents.
    '
    'Created by:            Stephen Lebans
    '
    'Credits:              If you want some...take some.
    '
    'Date:                  May 22, 2001
    '
    'Time:                  10:10:10pm
    '
    'Feedback:              Stephen@lebans.com
    '
    'My Web Page:          www.lebans.com
    '
    'Copyright:            Lebans Holdings Ltd.
    '                      Please feel free to use this code
    '                      without restriction in any application you develop.
    '                      This code may not be resold by itself or as
    '                      part of a collection.
    '
    'What's Missing:        Let me know!
    '
    '
    '
    'Bugs:
    'None at this point.
    '
    'Enjoy
    'Stephen Lebans
    
    '***************Code Start***************
    
    ' Structure for DrawText calc
    Dim sRect As RECT
    
    ' Reports Device Context
    Dim hdc As LongPtr
    
    ' Holds the current screen resolution
    Dim lngDPI As Long
    
    Dim newfont As Long
    ' Handle to our Font Object we created.
    ' We must destroy it before exiting main function
    
    Dim oldfont As LongPtr
    ' Device COntext's Font we must Select back into the DC
    ' before we exit this function.
    
    ' Temporary holder for returns from API calls
    Dim lngRet As LongPtr
    
    ' Logfont struct
    Dim myfont As LOGFONT
    
    ' TextMetric struct
    Dim tm As TEXTMETRIC
    
    ' LineSpacing Amount
    Dim lngLineSpacing As Long
    
    ' Ttemp var
    Dim numLines As Long
    
    ' Temp string var for current printer name
    Dim strName As String
    
    ' Temp vars
    Dim sngTemp1 As Single
    Dim sngTemp2 As Single
    
    On Error GoTo Err_Handler
    
    ' If we are being called from a Form then SKIP
    ' the logic to Create a Printer DC and simply use
    ' the Screen's DC
    
    If TypeOf ctl.Parent Is Access.Report Then
        ' ***************************************************
        ' Warning! Do not use Printer's Device Context for Forms.
        ' This alternative is meant for Report's only!!!!!
        ' For a Report the best accuracy is obtained if you get a handle to
        ' the printer's Device Context instead of the Screen's.
        ' You can uncomment his code and comment out the
        ' apiGetDc line of code.
        ' We need to use the Printer's Device Context
        ' in order to more closely match Font height calcs
        ' with actual ouptut. This example simply uses the
        ' default printer for the system. You could also
        ' add logic to use the Devnames property if this
        ' report prints to a specific printer.
        strName = GetDefaultPrintersName
        hdc = CreateDCbyNum("WINSPOOL", strName, 0&, 0&)
        If hdc = 0 Then
            ' Error cannot get handle to printer Device Context
            Err.Raise vbObjectError + 255, "fTextWidthOrHeight", "Cannot Create Printer DC"
        End If
        ' ***************************************************
    Else
        ' Get handle to screen Device Context
        hdc = apiGetDC(0&)
    End If
    
    ' Were we passed a valid string
    If Len(sText & vbNullString) = 0 Then
        ' Did we get a valid control passed to us?
        'select case typeof ctl is
        Select Case ctl.ControlType
            
            Case acTextBox
                sText = Nz(ctl.Value, vbNullString)
                
            Case acLabel, acCommandButton
                sText = Nz(ctl.Caption, vbNullString)
                
            Case acListBox
                sText = Nz(ctl.ItemData(0), vbNullString)
                
            Case Else
                ' Fail - not a control we can work with
                fTextWidthOrHeight = 0
                Exit Function
        End Select
    End If
    
    
    ' Get current device resolution
    ' blWH=TRUE then we are TextHeight
    If blWH Then
        lngDPI = apiGetDeviceCaps(hdc, LOGPIXELSY)
    Else
        lngDPI = apiGetDeviceCaps(hdc, LOGPIXELSX)
    End If
    
    ' Calculate TwipsPerPixel
    TwipsPerPixel = TWIPSPERINCH / lngDPI
    
    ' We use a negative value to signify
    ' to the CreateFont function that we want a Glyph
    ' outline of this size not a bounding box.
    ' Copy font stuff from Text Control's property sheet
    With ctl
        myfont.lfClipPrecision = CLIP_LH_ANGLES
        myfont.lfOutPrecision = 0 ' sl APRIL 08/2002OUT_TT_ONLY_PRECIS
        myfont.lfEscapement = 0
        myfont.lfFaceName = .FontName & Chr$(0)
        myfont.lfWeight = .FontWeight
        myfont.lfItalic = .FontItalic
        myfont.lfUnderline = .FontUnderline
        'Must be a negative figure for height or system will return
        'closest match on character cell not glyph
        myfont.lfHeight = (.FontSize / 72) * -lngDPI
        ' Create our temp font
        newfont = apiCreateFontIndirect(myfont)
    End With
    
    If newfont = 0 Then
        Err.Raise vbObjectError + 256, "fTextWidthOrHeight", "Cannot Create Font"
    End If
    
    ' Select the new font into our DC.
    oldfont = apiSelectObject(hdc, newfont)
    ' Use DrawText to Calculate height of Rectangle required to hold
    ' the current contents of the Control passed to this function.
    With sRect
        .Left = 0
        .Top = 0
        .Bottom = 0
        ' blWH=TRUE then we are TextHeight
        If blWH Then
            .Right = (ctl.Width / (TWIPSPERINCH / lngDPI)) - 10
        Else
            ' Single line TextWidth
            .Right = 32000
        End If
        
        ' Calculate our bounding box based on the controls current width
        lngRet = apiDrawText(hdc, sText, -1, sRect, DT_CALCRECT Or DT_TOP Or _
            DT_LEFT Or DT_WORDBREAK Or DT_NOCLIP)  ' not for this version!
        
        ' Get TextMetrics. This is required to determine
        ' Text height and the amount of extra spacing between lines.
        lngRet = GetTextMetrics(hdc, tm)
        
        ' Cleanup
        lngRet = apiSelectObject(hdc, oldfont)
        ' Delete the Font we created
        apiDeleteObject (newfont)
        
        If TypeOf ctl.Parent Is Access.Report Then
            ' ***************************************************
            ' If you are using the Printers' DC then uncomment below
            ' and comment out the apiReleaseDc line of code below
            ' Delete our handle to the Printer DC
            lngRet = apiDeleteDC(hdc)
            ' ***************************************************
        Else
            ' Release the handle to the Screen's DC
            lngRet = apiReleaseDC(0&, hdc)
        End If
        
        ' Calculate how many lines we are displaying
        ' return to calling function. The GDI incorrectly
        ' calculates the bounding rectangle because
        ' of rounding errors converting to Integers.
        TotalLines = .Bottom / (tm.tmHeight + tm.tmExternalLeading)
        numLines = TotalLines
        
        ' Convert RECT values to TWIPS
        .Bottom = (.Bottom) * (TWIPSPERINCH / lngDPI) 'sngTemp2 ' + 20
        
        ' Return values in optional vars
        ' Convert RECT Pixel values to TWIPS
        HeightTwips = .Bottom '* (TWIPSPERINCH / lngDPI)
        WidthTwips = .Right * (TWIPSPERINCH / lngDPI) '(apiGetDeviceCaps(hDC, LOGPIXELSX)))
        
        ' blWH=TRUE then we are TextHeight
        If blWH Then
            fTextWidthOrHeight = HeightTwips
        Else
            fTextWidthOrHeight = WidthTwips
        End If
    End With
    
    ' Exit normally
Exit_OK:
    Exit Function
    
Err_Handler:
    Err.Raise Err.Source, Err.Number, Err.Description
    Resume Exit_OK
End Function

Function GetDefaultPrintersName() As String
    ' This function is from Peter Walker.
    ' Check out his web site at:
    ' http://www.users.bigpond.com/papwalker/
    Dim success As Long
    Dim nSize As Long
    Dim lpKeyName As String
    Dim ret As String
    Dim posDriver
    'call the API passing null as the parameter
    'for the lpKeyName parameter. This causes
    'the API to return a list of all keys under
    'that section. Pad the passed string large
    'enough to hold the data. Adjust to suit.
    ret = Space$(8102)
    nSize = Len(ret)
    success = GetProfileString("windows", "device", "", ret, nSize)
    posDriver = InStr(ret, ",")
    GetDefaultPrintersName = Left$(ret, posDriver - 1)
End Function

Public Function ScreenTwipsPerPixel() As Long
    Dim hdc As LongPtr
    Dim lngRet As LongPtr
    
    ' Get handle to screen Device Context
    hdc = apiGetDC(0&)
    ScreenTwipsPerPixel = TWIPSPERINCH / apiGetDeviceCaps(hdc, LOGPIXELSY)
    
    ' Release the handle to the Screen's DC
    lngRet = apiReleaseDC(0&, hdc)
End Function


'/Goi ham de canh giua hang doc
Public Sub VerticallyCenter(ByRef ctl As Control)
    Dim lngHeight As Long
    lngHeight = fTextHeight(ctl)
    ctl.TopMargin = ((ctl.Height - lngHeight) / 2)
End Sub 

  
  
  * Gọi hàm này trong Form và Report: thiết lập thuộc tính Tag cho các texbox hoặc label nào muốn áp dụng hàm
  
  
  Mã PHP:

  Option Compare Database
Option Explicit

Private Sub Form_Current()
    thietLapCanhGiuDoc
End Sub

Private Sub Form_Load()
    thietLapCanhGiuDoc
End Sub

Sub thietLapCanhGiuDoc()
    Dim ctl As Control
    For Each ctl In Me.Controls
        'Chi ap dung cho Textbox va Label va Tag phai có chuoi "verAlg" moi canh giua hang doc
        If (ctl.ControlType = acTextBox Or ctl.ControlType = acLabel) And (ctl.Tag Like "verAlg") Then
            VerticallyCenter ctl    'LEBAN
        End If
    Next
End Sub 

  
  
  Mã PHP:

  Option Compare Database
Option Explicit

Private Sub Report_Load()
    Dim ctl As Control
    For Each ctl In Me.Controls
        If ctl.ControlType = acTextBox Or ctl.ControlType = acLabel Then
            On Error Resume Next    'bo qua loi 2100: khi lay chieu cao text > chieu cao control => giam font size.
            VerticallyCenter ctl
        End If
    Next
End Sub 

  
  


•   Đặt điều kiện cho Crosstab query
  

  Viết bởi: mrgior 04-10-24, 09:47 PM Chuyên mục: Query - Bài trả lời (1)

• Em có tạo 1 Crosstab query như sau, nhưng khi thêm điều kiện để lọc theo ngày tháng thì bị báo lỗi như hình ạ
  
   
  
  
  Nhờ các bác giúp e với ạ
  


•   Đặt điều kiện trong Cross tab query
  

  Viết bởi: mrgior 04-10-24, 09:35 PM Chuyên mục: Query - Không có hồi đáp

• Trùng thread
  mod xóa giúp e với ạ
  


•   Function tạo barcode 128 cho excel lẫn accsee (form và report))
  

  Viết bởi: tranthanhan1962 19-09-24, 12:16 AM Chuyên mục: Thư Viện Ứng Dụng - Bài trả lời (3)

• Từ khi đụng đến việc tạo mã vạch trên access tôi thực sự cảm thấy khó khăn và bối rối với đọ phức tạp của nó. Tôi viết phần mềm cho khách chủ yếu dùng để bán hàng. May mắn khách hàng có những máy đọc mã vạch chuyên dụng thường là của Mỹ gởi về thì rất dễ. Vì với máy này vừa mới, vừa nhạy khi tạo mã vạch cứ lấy trực tiếp code ra chuyển font rồi in là nó cứ đọc không cần xử lý gì thêm. Ví dụ Code = ABCD cứ chuyển thành ABCD theo font 39 hay 128 khi Khi đọc bật nút máy đọc mã vạch qua 39 hay 128 tùy theo font in rồi đưa máy vào là quét. Điều dễ dàng là nếu đọc không được 39 chắc chắn là 128. Sau này mấy máy Trung Quốc thì không thể lơi kiểu chuyển font trực tiếp nữa vì máy sẽ không hiểu. Cho đén lúc này ngay cả máy đọc mã vạch của Mỹ kiểu này cũng không còn sản xuất nữa vì đâu chỉ có mã vạch code 39 và code 128 mà nó có hàng đống chuẩn. Lúc bắt đầu với mấy cái máy đọc mã vạch của Hồ Cẩm Đào Tôi phải tiếp cận với phần mềm BarTender. Đói với mình thì dễ nhưng đối với khách hàng thì việc tạo mã vạch bằng phần mềm này là cơn ác mộng đối với họ. Các bạn sẽ thấy khi viết xong một phần mềm xử lý hoàn tất mọi vấn đề mà cứ phải nghe điện thoại kêu réo suốt tại vì họ không tự tạo được mã vạch để in, riết rồi mình giống như nhân viên tạo mã vạch không công cho họ. Sau này nhờ code tạo mã vạch Function Barcode_128(Ctrl As Control, rpt As Report) của ongke0711 đã hỗ trợ mình rất nhiều, nó giả quyết được việc tự động đỗi code thành font mã vạch 128. Thực sự tôi rất nể đoạn người viết đoạn code này (không biết có phải đ/c ongke0711 viết không!) vì đây là đoạn code không dùng bất kỳ font chữ nào mà dùng cú pháp Line của access để vẽ thành những sọc vuông tạo thành mã vạch 128. quá dữ, Một điều là hạn chế là code này chỉ thể hiện được trên report chứ không thể hiện được trên form. Lý do đơn giản là trên form không có event print hay format để xử lý cú pháp Line (hoặc là có cách nào đó để thực hiện cú pháp này mà tôi không biết). Thực ra việc thể hiện mã vạch trên form không nhiều nhưng cũng có đôi lúc cần cho công việc. Mò mẫ mãi tôi gặp được trang web https://graphicore.github.io/librebarcode/ thông qua nó tôi biết được tất cả các barcode đều sử dụng 1 công thức:
  [Ký tự đầu] & Code & [Ký tự cuối]:
  
  Mã PHP:

  Code 39=*code* (Đầu: *, cuối: *)
Code 128 = ÌCodeWΠ(Đầu: Ì, cuối: WÎ)
Code EAN-13 = 00Code? (code 10 ký tự; đầu: 00, cuối: ? => tổng 13 ký tự)
Code EAN-8 = Code? (code 7 ký tự, cuối: ? => tổng 8 ký tự)
Code UPC-A = 0 Code? (code 10 ký tự, đầu:0, cuối: ? => tổng 12 ký tự)
Code UPC-E short input = xCode? (code 6 ký tự, đầu:0, cuối ? => tổng 8 ký tự) 

  Còn 1 số chuẩn mà tôi không kể hết ra đây vả lại các chuẩn này sẽ còn tăng lên tùy theo các quôc gia và vùng lãnh thổ. Thực ra theo tôi đối với công việc cá nhân hoặc quản lý các doanh nghiệp thì Barcode 128 là ưu việc hơn cả. 1 là trong cùng 1 code thì tạo Barcode 128 sẽ ngắn hơn Barcode 39. 2 là barcode 39 và 128 không khống chế số ký tự tạo code, bao nhiêu cũng được chỉ cần đầu đọc đủ gần để nhận rõ ký tự và đủ xa để bao quát toàn bộ ký tự là Ok và barcode 128 sẽ có chiều rộng ngắn barcode 39. Vì vậy chỉ cần xử lý 1 function barcode 128 là sử dụng được cho tất cả. Tôi đã tạo 1 function xử lý trực tiếp code ra barcode 128 dưới đây và đã text OK.
  
  Mã:

  Function Code128(Data As String) As String
    Dim i As Integer
    Dim checksum As Integer
    Dim result As String
    Dim charValue As Integer
   
    ' Ký tự bắt đầu cho Code 128
    result = Chr(204)
    checksum = 104 ' Giá trị bắt đầu cho Code 128
   
    ' Mã hóa dữ liệu
    For i = 1 To Len(Data)
        charValue = Asc(Mid(Data, i, 1))
        result = result & Mid(Data, i, 1)
        checksum = checksum + (charValue - 32) * i
    Next i
   
    ' Tính toán ký tự kiểm tra
    checksum = checksum Mod 103
    result = result & Chr(checksum + 32)
   
    ' Ký tự kết thúc cho Code 128
    result = result & Chr(206)
   
    Code128 = result
End Function
  Mã này áp dụng được trong module excel lẫn access cả form lẫn report. Các barcode khác cũng chỉ cần thay đổi function xử lý lại ký tự đầu và cuối. Nếu barcode nào có xác định số lượng ký tự thì kiểm tra len(code) trước
  


•   Cho chỉ định xét nghiệm và nhập kết quả
  

  Viết bởi: danhxetnghiem 03-07-24, 08:08 PM Chuyên mục: Forms - Bài trả lời (9)

• Hiện tại mình lục lại được 1 cái demo chắc cũng 10 năm rồi,
  giờ muốn mò lại làm tiếp mấy thứ còn chưa xong.
  
  demo
  
  Mình muốn sau khi cho chỉ định là 3 cái men gan, hoặc Công thức máu thì khi tạo 1 cái from trả kết quả mở bệnh này lên thì nó hiện lên các xét nghiệm đã cho và mình bấm kết quả vào.
  
  Không biết nói vậy Các Pro có hiểu không? 
  vd1: khi cho xét nghiệm GOT: thì mở from trả kết quả chỉ hiện 1 dòng GOT và mình nhập chỉ số vào, bên cạnh đó nó hiện chỉ số bình thường và đơn vị lên luôn,
  vd2: Khi cho công thức máu 18 thông số: thì khi mở from trả kết quả lên nó hiện lên 18 dòng để mình nhập kết quả.
  
  Hiện tại theo cái demo ở trên thì mình phải thiết kế cái from "TRẢ KẾT QUẢ" như thế nào. ở table có cần thêm những table nào, và liên kết chúng ra sao....
  
  Xin cho mình hướng xử lý. cảm ơn!
  



Chủ đề Mới nhất

Tạo query tổng hợp dữ liệ... -Chuyên mục: Query-Đăng bởi lần cuối: ongke0711-19-12-24, 07:58 PM- » Bài trả lời: 1- » Lượt xem: 41

Test phần mềm QUẢN LÝ TÀI... -Chuyên mục: Thư Viện Ứng Dụng-Đăng bởi lần cuối: AnNguyen-19-12-24, 05:33 PM- » Bài trả lời: 44- » Lượt xem: 5,189

A Bold Move to Expand the... -Chuyên mục: Query-Đăng bởi lần cuối: nigelbdhmp-19-12-24, 04:55 PM- » Bài trả lời: 0- » Lượt xem: 7

Quản lý kho bằng Accesss -Chuyên mục: Thảo Luận Access-Đăng bởi lần cuối: danhson2007-19-12-24, 03:54 PM- » Bài trả lời: 56- » Lượt xem: 3,086

Dòng Video Youtube Ngâm N... -Chuyên mục: Góc Thơ -Đăng bởi lần cuối: Nguyễn Thành Sáng-19-12-24, 01:21 PM- » Bài trả lời: 43- » Lượt xem: 374

[Demo p2] Tìm kiếm và tô ... -Chuyên mục: Thủ thuật VBA-Đăng bởi lần cuối: ledangvan-06-12-24, 02:53 PM- » Bài trả lời: 17- » Lượt xem: 1,944

File Sổ Quỹ Tiền Mặt cho ... -Chuyên mục: Thư Viện Ứng Dụng-Đăng bởi lần cuối: giauvnd-05-12-24, 04:35 PM- » Bài trả lời: 30- » Lượt xem: 3,681

Hỏi về Crosstab Query: Lu... -Chuyên mục: Query-Đăng bởi lần cuối: feeling-04-12-24, 07:24 PM- » Bài trả lời: 7- » Lượt xem: 270

Demo_Code Xuất Lý lịch 2C... -Chuyên mục: Tương tác Chương trình ngoài-Đăng bởi lần cuối: shangyi-02-12-24, 02:18 PM- » Bài trả lời: 19- » Lượt xem: 2,598

Label không hiện dữ liệu ... -Chuyên mục: Report-Đăng bởi lần cuối: AnNguyen-29-11-24, 10:09 AM- » Bài trả lời: 6- » Lượt xem: 136




Diễn đàn Thống kê

» Thành viên: 5,083 » Thành viên mới nhất: carloogbuyNeern » Các chủ đề diễn đàn: 9,878 » Các bài viết diễn: 48,656 Thống kê đầy đủ