Em muốn chỉnh cho dữ liệu khi xuất ra báo cáo thì dữ liệu sẽ tự thu nhỏ cho vừa texbox nếu văn bản dài hơn textbox giiongs như thuộc tính Shink trong excell ý ah ( không phải là textbox tự dãn theo chữ nhé) vì muốn cố định hàng và cột. mong các bác chỉ giáo

(13-08-17, 02:42 AM)phanthang Đã viết: Em muốn chỉnh cho dữ liệu khi xuất ra báo cáo thì dữ liệu sẽ tự thu nhỏ cho vừa texbox nếu văn bản dài hơn textbox giiongs như thuộc tính Shink trong excell ý ah ( không phải là textbox tự dãn theo chữ nhé) vì muốn cố định hàng và cột. mong các bác chỉ giáo

Chào Bạn,
Chắc ý Bạn muốn rằng khi Report được in ra, nếu nội dung dữ liệu của 1 ô vượt quá chiều rộng của ô đó thì cho tự động xuống dòng và được kẻ ô cho đúng với chiều cao nhất của các ô dữ liệu.
Nếu ý của Bạn đúng như vậy, Bạn cần phải viết code VBA cho sự kiện in từng dòng trong vùng Detail của Report (Detail Print Event). MS Access không có sẵn định dạng cho nhu cầu này.
 
Có thể tóm tắt giải pháp như sau:
1. Phải tắt hết việc in đường kẻ ô của các ô dữ liệu trong vùng Detail (Border Style = Transparent)
Việc kẻ ô này ta sẽ cho thực hiện bằng code VBA tự viết.
 
2. Khai báo 2 thuộc tính “Can Grow” và “Can Shink” là Yes, nghĩa là cho tự động co dãn nội dung của từng ô dữ liệu (Trên Report của Access thì chỉ co dãn theo chiều cao của textbox thôi, còn chiều rộng thì không)
 
3. Viết code VBA cho sự kiện in vùng Detail (Detail Print Event), trong code ấy:
- Mỗi khi in 1 dòng, ta sẽ cho duyệt qua chiều cao của từng ô trong vùng Detail để lấy ra chiều cao nhất.
- Sau đó, vẽ khung chữ nhật cho từng ô với các tọa độ và kích thước như sau:
+ Đỉnh trái của khung chữ nhật = chỉ số lề trái (Left) của ô
+ Chiều rộng của khung chữ nhật = chiều rộng của ô
+ Chiều cao của khung chữ nhật = chiều cao nhất mà ta đã xác định được ở trên.
 
4. Code VBA mẫu:

Và đây là kết quả bản in:


Trong code VBA trên có sử dụng Line method của Report. 


Các Bạn tham khảo tài liệu giải thích và hướng dẫn của Microsoft tại link sau nhé: https://msdn.microsoft.com/VBA/Access-VB...hod-access

cái này có đấy, nó co nhỏ chữ lại cho vừa textbox, còn có xuống dòng không thì chưa thử, mình áp dụng để làm thẻ tên nhân viên (hiện đang onl bằng mobile lên ko có demo)

(13-08-17, 02:42 AM)phanthang Đã viết: Em muốn chỉnh cho dữ liệu khi xuất ra báo cáo thì dữ liệu sẽ tự thu nhỏ cho vừa texbox nếu văn bản dài hơn textbox giiongs như thuộc tính Shink trong excell ý ah ( không phải là textbox tự dãn theo chữ nhé) vì muốn cố định hàng và cột. mong các bác chỉ giáo

Cảm ơn bác. ý em là text co nhỏ lại cho vừa textbox ah

(13-08-17, 08:45 AM)lehongduc Đã viết:

(13-08-17, 02:42 AM)phanthang Đã viết: Em muốn chỉnh cho dữ liệu khi xuất ra báo cáo thì dữ liệu sẽ tự thu nhỏ cho vừa texbox nếu văn bản dài hơn textbox giiongs như thuộc tính Shink trong excell ý ah ( không phải là textbox tự dãn theo chữ nhé) vì muốn cố định hàng và cột. mong các bác chỉ giáo

Chào Bạn,
Chắc ý Bạn muốn rằng khi Report được in ra, nếu nội dung dữ liệu của 1 ô vượt quá chiều rộng của ô đó thì cho tự động xuống dòng và được kẻ ô cho đúng với chiều cao nhất của các ô dữ liệu.
Nếu ý của Bạn đúng như vậy, Bạn cần phải viết code VBA cho sự kiện in từng dòng trong vùng Detail của Report (Detail Print Event). MS Access không có sẵn định dạng cho nhu cầu này.
 
Có thể tóm tắt giải pháp như sau:
1. Phải tắt hết việc in đường kẻ ô của các ô dữ liệu trong vùng Detail (Border Style = Transparent)
Việc kẻ ô này ta sẽ cho thực hiện bằng code VBA tự viết.
 
2. Khai báo 2 thuộc tính “Can Grow” và “Can Shink” là Yes, nghĩa là cho tự động co dãn nội dung của từng ô dữ liệu (Trên Report của Access thì chỉ co dãn theo chiều cao của textbox thôi, còn chiều rộng thì không)
 
3. Viết code VBA cho sự kiện in vùng Detail (Detail Print Event), trong code ấy:
- Mỗi khi in 1 dòng, ta sẽ cho duyệt qua chiều cao của từng ô trong vùng Detail để lấy ra chiều cao nhất.
- Sau đó, vẽ khung chữ nhật cho từng ô với các tọa độ và kích thước như sau:
+ Đỉnh trái của khung chữ nhật = chỉ số lề trái (Left) của ô
+ Chiều rộng của khung chữ nhật = chiều rộng của ô
+ Chiều cao của khung chữ nhật = chiều cao nhất mà ta đã xác định được ở trên.
 
4. Code VBA mẫu:

Mã:

Private Sub Detail2_Print(Cancel As Integer, PrintCount As Integer)
Dim ctl As Control, ctlName As String
Dim lngMaxHeight As Long
Dim intCtrl As Long, k As Long
Dim ArrayCtl(50) As String
If GetValue("TatKhuyenmai") = True Then
    If Me.Dongia = 0 Then
        Cancel = True
        Exit Sub
    End If
End If

intCtrl = 0

For Each ctl In Me.Controls
    
    ctlName = ctl.Name
    If Me.Controls(ctlName).Section = 0 And Me.Controls(ctlName).ControlType = acTextBox Then
        If Me.Controls(ctlName).Height > lngMaxHeight Then
            lngMaxHeight = Me.Controls(ctlName).Height
        End If
        intCtrl = intCtrl + 1
        ArrayCtl(intCtrl) = ctlName
    End If
Next ctl

For k = 1 To intCtrl
    ctlName = ArrayCtl(k)
    Set ctl = Me.Controls(ctlName)

    Me.Line (ctl.Left, ctl.Top)-Step(ctl.Width, lngMaxHeight), , B
Next

Set ctl = Nothing
End Sub

Và đây là kết quả bản in:


Trong code VBA trên có sử dụng Line method của Report. 


Các Bạn tham khảo tài liệu giải thích và hướng dẫn của Microsoft tại link sau nhé: https://msdn.microsoft.com/VBA/Access-VB...hod-access

Cảm ơn bác. ý em là text co nhỏ lại cho vừa textbox ah

(13-08-17, 06:18 PM)cpucloi Đã viết: cái này có đấy, nó co nhỏ chữ lại cho vừa textbox, còn có xuống dòng không thì chưa thử, mình áp dụng để làm thẻ tên nhân viên (hiện đang onl bằng mobile lên ko có demo)

Đúng ý em đấy ah, bác demo chi tiết giúp em, em tự mò thôi nên kiến thức hạn hẹp

Cái này mình sưu tầm được trên Internet khá lâu, không rõ của ai, nếu của ai vui lòng cmt để mình bổ sung thông tin
1.       Tạo Module
 

Mã PHP:

Option Compare Database
[/font][/size][/color]Option Explicit
Private Type Size
       cx As Long
       cy As Long
End Type
' Declare API functions.
Private Declare PtrSafe Function CreateFont Lib "gdi32" Alias "CreateFontA" _
(ByVal H As Long, ByVal w As Long, ByVal E As Long, ByVal O As Long, _
ByVal w As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, _
ByVal c As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long
Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare PtrSafe Function apiDeleteObject Lib "gdi32" _
Alias "DeleteObject" (ByVal hObject As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function MulDiv Lib "kernel32" (ByVal nNumber As Long, _
ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare PtrSafe Function CreateIC Lib "gdi32" Alias "CreateICA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As String, lpInitData As Any) As Long
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare PtrSafe Function apiGetTextExtentPoint32 Lib "gdi32" _
 Alias "GetTextExtentPoint32A" _
 (ByVal hdc As Long, ByVal lpsz As String, _
 ByVal cbString As Long, lpSize As Size) As Long
Private Declare PtrSafe Function apiGetDC Lib "user32" _
 Alias "GetDC" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiReleaseDC Lib "user32" _
Alias "ReleaseDC" (ByVal hWnd As Long, _
ByVal hdc As Long) As Long
Private Declare PtrSafe Function apiDeleteDC Lib "gdi32" _
 Alias "DeleteDC" (ByVal hdc As Long) As Long
Private Declare PtrSafe Function RestoreDC Lib "gdi32" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
Private Declare PtrSafe Function SaveDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare PtrSafe Function GetTextAlign Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare PtrSafe Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long

'Used to ask System for the Logical pixels/inch in Y axis
Const LOGPIXELSY = 90
'Used to ask System for the Logical pixels/inch in X axis
Const LOGPIXELSX = 88
'Stock Object - System Font
Const SYSTEM_FONT = 13
'**LEAVE THESE AS PUBLIC VARS

'Handle to Report's window
Dim hWnd As Long
'Reports Device Context
Dim hdc As Long
'Holds the current screen resolution
Dim lngYdpi As Long
Function fMakeFitSingle(ctl As Control, FontHeight As Integer) As Boolean

   'Name                   fMakeFit
   'Purpose:               Resize Font to make text fit into
   '                       a fixed size Text Control
   'Version:               1.0 RAW :-)
   'Calls                  Text API stuff
   'Created by:            Stephen Lebans
   'Date:                  Oct 23, 1999
   'Time:                  11:40:18pm
   'Feedback:              macarthu@nbnet.nb.ca
   'My Web Page:           http://www.lebans.com
   'Copyright:             Lebans Holdings Ltd.
   '                       May not be resold in whole or part
   '                       but may be used without restriction
   '                       in any software you develop.
   '
   'Calculates the Font size required to force the current
   'text to fit inside the fixed size Text Control
   'WORKS WITH SINGLE LINE DATA ONLY!!!!!!!!!!!!!!!
   'See modMakeFitMemo to handle multiple lines.
    'Bugs:
   'Not tested enough to tell. Let me know
   '
   'Enjoy
   'Stephen Lebans
 
   '***************Code Start***************
   Dim hFont As Long
   'handle to font we created in MakeFont
   'so that we can destroy it before exiting main function
   Dim hFontCtl
   'font that was selected in DC first time through
   'this function
     'Temporary holder for returns from API calls
   Dim lngret As Long
   'Calculate screen Font height
   Dim fheight As Long
 
   'Holder for what Font Size works
   Dim intFontHeight
   hWnd = ctl.Parent.hWnd
   'retrieve a handle to a display device context (DC)
   'for the client area of the specified window
   hdc = apiGetDC(hWnd)
  
   'Let's save the current state of the DC to restore after
   'We will be changing the font size
   'lngRet = SaveDC(hdc)
  
   'Store this so we can reset the Font that was initially selected into
   'the hdc when we entered this function
   'Nevermind, we've picked it up upon entering this function instead
 
   hFontCtl = SelectObject(hdc, GetStockObject(SYSTEM_FONT))
   lngret = SelectObject(hdc, hFontCtl)
 
   'Do we have to bother calling the
   'main function?

   If Not IsNull(ctl.Value) Then
   If ctl.Value <> "" Then
 
   'Clear our return value
   lngret = 0
  

   '**************

   ' MakeFont uses FontHeight passed in Function call

 

   ' Lets make sure our Control's Fontsize is the same

   ' as the size passed to this function

   ctl.FontSize = FontHeight
  

 Do While lngret >= 0

   hFont = makefont(hdc, ctl)

   lngret = JustifyText(hdc, ctl)
 
  

   Select Case lngret

       Case -2

       'Put your error handlers here

       hFont = SelectObject(hdc, hFontCtl)

       lngret = apiDeleteObject(hFont)

       lngret = apiReleaseDC(hWnd, hdc)

       fMakeFitSingle = False

       Exit Function

       

       

       Case -1

       'Everything OK

       'Cleanup!

       hFont = SelectObject(hdc, hFontCtl)

       lngret = apiDeleteObject(hFont)

       lngret = apiReleaseDC(hWnd, hdc)

       fMakeFitSingle = True

       Exit Function

   

       Case 0

       'Everything OK

       'Cleanup!

       hFont = SelectObject(hdc, hFontCtl)

       lngret = apiDeleteObject(hFont)

       lngret = apiReleaseDC(hWnd, hdc)

       fMakeFitSingle = True

       Exit Function

       

       Case Else

       'Here is the actual number of characters

       'left that didn't fit in the box

       'you could use this number to speed up

       'the process. I don't here

       ctl.FontSize = ctl.FontSize - 1

       'Let's get real here. How small

       'can you go. This is for error handling

       'as well so put something here.

       If ctl.FontSize < 3 Then Exit Do

   

   End Select

 

 Loop

 

 'Control's value is null

 End If

   'Control's value is a zero length string

   End If

   

   'Cleanup!

   hFont = SelectObject(hdc, hFontCtl)

   lngret = apiDeleteObject(hFont)

   lngret = apiReleaseDC(hWnd, hdc)

   fMakeFitSingle = True

End Function

Private Function JustifyText(hdc As Long, ctl As Control) As Long

 

 'This function is adapted from my Justification function.

 'IT IS FOR SINGLE LINE DATA ONLY!!!!!!!!!!!!!!!!!!!!!

 

 'API's need UserControl.Width in Pixels not Twips

 Dim UserControlWidthPixels As Integer

 Dim UserControlHeightPixels As Integer

    

 'Junk holder for Return values we don't use

 Dim lngReturn As Long

 

 'UDT to hold Text Height and Width from API

 Dim lpSize As Size

   

'This is the actual Text string(Caption)

 Dim pText As String

 

 'Length of the entire string to be output.

 Dim CaptionLength As Integer

 

 'Grab the current string from the control

 

 pText = ctl.Value

 CaptionLength = Len(pText)

 On Error GoTo MYHandler

 

 'Calculate Current UserControl.Width in Pixels

 UserControlWidthPixels = (ctl.Width \ (1440 \ lngYdpi))

 'UserControlHeightPixels = (ctl.Height \ (1440 \ lngYdpi))

 

 'We have to leave space for the border

 'Adjust as you see fit! :-)

 'Must be a minimum of 10 pixels otherwise

 'to allow for the border width Access uses to calculate

 'what text will actaully fit in a control

UserControlWidthPixels = UserControlWidthPixels - 10

 'UserControlHeightPixels = UserControlHeightPixels - 6

   

 ' See if current text in control FITS

   

  lngReturn = apiGetTextExtentPoint32(hdc, pText, Len(pText), lpSize)

  'Debug.Print "Ctl.FontSize:" & ctl.fontsize & "  | " & "lpsize.cx:" & lpSize.cx & " | " _

  '& "CtlWidth:" & UserControlWidthPixels & " | " & ctl.Value

  

  If lpSize.cx >= UserControlWidthPixels Then

  ' Keep reducing Font Size - still doesn't fit.

  JustifyText = 1

  Else

  ' OK it fits we'er all done

  JustifyText = -1

  

  End If

  Exit Function

    

  

  

MYHandler:

'Add your own handlers here.

On Error Resume Next

JustifyText = -2

End



End Function

Private Function makefont(hdc As Long, ctl As Control) As Long

'Returns handle to newfont so we can delete it when we exit amin function

 Dim newfont As Long

 Dim oldfont As Long

 Dim lngret As Boolean

 

 Dim fheight As Integer

 

 'Temporary Information Context for Screen info.

 Dim lngIc As Long

   

 'Modified to allow for different screen resolutions

 'and printer output. Needed to Calculate Font size

 lngIc = CreateIC("DISPLAY", vbNullString, vbNullString, vbNullString)

 If lngIc <> 0 Then

   lngYdpi = GetDeviceCaps(lngIc, LOGPIXELSY)

   DeleteDC (lngIc)

 Else

   lngYdpi = 120 'Default average value

 End If

  

 'Calculate/Convert requested Font Height

 'into Font's Device Coordinate space

 fheight = MulDiv(ctl.FontSize, lngYdpi, 72)

 

 'We use a negative value to signify

 'to the CreateFont function that we want a Glyph

 'outline of this size not a bounding box.

 

 With ctl

 newfont = CreateFont(-fheight, 0, _

     0, 0, .FontWeight, _

     .FontItalic, .FontUnderline, _

     0, 0, 0, _

      0, 0, 0, .FontName)

  End With

 ' Select the new font.

 oldfont = SelectObject(hdc, newfont)

 

 'I was worried about trying to delete the

 'font originally selected into the Control

 'in Report Design view.

 'Doesn't seem to be causing any problems

 '...running very fast away! :-)

 apiDeleteObject (oldfont)

 

 'Return handle to font to be destroyed when we exit main function

 'actually I've decided to pick it up as we enter the main function

 makefont = newfont

 End Function


[color=#000000][size=small][font=Calibri] 


2.       Tại thuộc tính Onformat
Với số 14 là cỡ lớn nhất mà bạn muốn, txt_hovaten là textbox muốn căn chữ
 

Mã PHP:

   Dim lngret2 As Long 'For Last Name Control
[/font][/size][/color]
   lngret2 = fMakeFitSingle(txt_hovaten, 14)
[color=#000000][size=small][font=Calibri] 


 
View report của bạn để xem thành quả.
Lưu ý, cách này dòng chữ không tự động xuống dòng khi vượt qua chiều rộng textbox, cỡ chữ thu nhỏ đến khi dòng chữ bằng chiều rộng textbox.