Chuyển đến nội dung
Diễn đàn CADViet
singfeng

Hỗ trợ về hàm VBA chèn bảng vào EXCEL

Các bài được khuyến nghị

Chào mn người. Em có 1 đoạn VBA chèn bảng từ excel vào Autocad nhưng bảng chèn vào bị to quá. Có cách nào giảm kích thước khi chèn vào autocad không ạ.

 

Em cảm ơn ạ

 

image.png.8b70148bbc0201059cce216a4b766e5f.png

 

Sau đây là đoạn mã em gửi ạ 

 

Public Function TableStyle(Optional ByVal TableName As String = "Standard", _
                           Optional ByVal sFont As String = "Romans", _
                           Optional ByVal TopView As Boolean = True, _
                           Optional ByVal HeightData As Double = 10) As Object
                           
'Hµm t¹o Table Style
    On Error Resume Next
    
    '§é cao ch÷ & kho¶ng c¸ch thôt lÒ ch÷ cho b¶ng
    Dim hData As Double
    Dim hHeader As Double
    Dim hTitle As Double
    Dim horMargin As Double
    Dim verMargin As Double
    
    hData = HeightData
    hHeader = 1 * hData
    hTitle = 1.4 * hData
    horMargin = 1 / 2 * hData
    verMargin = 1 / 5 * hData

'B-T¹o kiÓu b¶ng & ®Þnh d¹ng
    'TiÕp cËn kho qu¶n lý c¸c ®èi t­îng AutoCAD
    Dim Dic As Object
    Set Dic = AcadDoc.Database.Dictionaries
    
    'Sö dông kho ®èi t­îng B¶ng
    Dim oDic As Object
    Set oDic = Dic.Item("acad_tablestyle")
    
    'Thªm vµo mét kiÓu B¶ng
    'Dim TableStyles As IAcadTableStyle  '§èi t­îng b¶ng, dïng ®Ó thÝ nghiÖm
    Dim TableClass As String
    TableClass = "AcDbTableStyle"
    Set TableStyle = oDic.AddObject(TableName, TableClass)
    
    'ThiÕt lËp kiÓu b¶ng võa t¹o lµ mÆc ®Þnh. Tham kh¶o, kh«ng dïng
    'AcadDoc.SetVariable "CTABLESTYLE", TableName
    
    'H­íng tr×nh bµy cña B¶ng: tõ trªn xuèng=0; tõ d­íi lªn=1
    If TopView Then
        TableStyle.FlowDirection = acTableTopToBottom
    Else
        TableStyle.FlowDirection = acTableBottomToTop
    End If
    
    'Thôt lÒ (ngang-däc) cña Text
    TableStyle.HorzCellMargin = horMargin
    TableStyle.VertCellMargin = verMargin
    
    'KiÓu ch÷ cña B¶ng (cïng mét TextStyle)
    TableStyle.SetTextStyle acTitleRow + acHeaderRow + acDataRow, TextStyleObj(TableName, sFont).Name
    
    'Mµu ch÷ tªn b¶ng
    Col.ColorIndex = acYellow
    TableStyle.SetColor acTitleRow, Col
    'Mµu ch÷ tªn cét
    Col.ColorIndex = acRed
    TableStyle.SetColor acHeaderRow, Col
    'Mµu ch÷ d÷ liÖu (mµu tr¾ng)
    Col.ColorIndex = acByBlock
    TableStyle.SetColor acDataRow, Col
    
    'Mµu nÒn: chØ t« mµu nÒn tªn cét.
    'V× thuéc tÝnh lµ "SetBackgroundColorNone" t­¬ng ®­¬ng víi "kh«ng cµi ®Æt mµu nÒn",
    'nªn ph¶i nhËn gi¸ trÞ False th× mµu nÒn míi hiÓn thÞ:
    Col.ColorIndex = 254
    TableStyle.SetBackgroundColor acHeaderRow, Col
    TableStyle.SetBackgroundColorNone acHeaderRow, False
    
    'Canh lÒ gi÷a cho tªn b¶ng & tªn cét:
    TableStyle.SetAlignment acTitleRow + acHeaderRow, acMiddleCenter
    'Canh lÒ tr¸i cho data:
    TableStyle.SetAlignment acDataRow, acMiddleLeft
    
    '§é cao ch÷ tªn b¶ng
    TableStyle.SetTextHeight acTitleRow, hTitle
    '§é cao ch÷ tªn cét
    TableStyle.SetTextHeight acHeaderRow, hHeader
    '§é cao ch÷ data
    TableStyle.SetTextHeight acDataRow, hData

End Function

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
1 giờ trước, phantuhuong đã nói:

Ít nhất phải có hình ảnh minh họa thì mọi người mới hiểu.

Dạ cảm ơn em có cập nhật thêm mình ảnh rồi ạ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

To insert a table into Excel using VBA, you can use the following code:

Sub InsertTable()

 Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1") 'Change to your sheet name

' Define the range where you want to insert the table

  Dim tableRange As Range

  Set tableRange = ws.Range("A1:D5") 'Change the range as needed

 ' Create the table

ws.ListObjects.Add(xlSrcRange, tableRange, , xlYes).Name = "MyTable" 'Creates a table with headers

End Sub danchoi.com

This code inserts a table into the specified range (A1:D5) and names it "MyTable". You can adjust the range and sheet as needed.

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×