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

[singfeng 1]

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 ạ

 

 

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

 

[phantuhuong 228]

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

[singfeng 1]

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 ạ

[myumyu 1]

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.