Attribute VB_Name = "XLhelper"

'-------------------------------------------------------------------------------------
' Excellink 2000/2004/2005 helper macros for Excel                (C)2004 Xanadu s.r.o.
' (Note: Excellink LT is not supported)
' 
' Excellink homepage:                http://www.xanadu.cz/excellink
' Excellink Helper Macros download:  http://www.xanadu.cz/download
' 
' Use Alt+F11 to start Excel VBA Editor, load XLhelper.bas by Ctrl+M, go back by Alt+Q
' In Excel, use Alt+F8 to run ZoomTo or XLimport or assign a hotkey to these macros:
'   in the Macro dialog use Options and assign e.g. the Ctrl+Z and Ctrl+I hotkeys
' 
' ZoomTo:    place cursor to a (single) cell with a (exported) X-coordinate and run
'            the ZoomTo macro (Ctrl+Z) -- AutoCAD will perform Zoom-Center to the
'            respective block reference (zoom size is 40x the TEXTHEIGHT value)
' XLimport:  performs Excellink-Import function from Excel (e.g. after a global change)
'            this is the same function as Import launched from the Excellink toolbar
' XLsummary: counts block occurrences in the exported table -- before export set
'            use export options "Use same sheet for all block definitions" and
'            check "Add header row" plus export "Block name" (invalidates the table for
'            re-imports to ACAD)
'--------------------------------------------------------------------------------------

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long

Sub ZoomTo()
Dim acadApp As Object
Dim acadDoc As Object
Dim hgt As Double
    
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    hgt = acadDoc.GetVariable("TEXTSIZE")
    
    Dim Center(0 To 2) As Double
    Dim magnification As Double
    Center(0) = ActiveCell.Value
    Center(1) = ActiveCell.Offset(0, 1).Value
    Center(2) = 0

    magnification = hgt * 40
    
    acadApp.ZoomCenter Center, magnification
    SetForegroundWindow (acadApp.hwnd)

End Sub

Sub XLimport()
Dim acadApp As Object
Dim hand As Long

    'AllowSetForegroundWindow
    hand = GetForegroundWindow()
    
    Set acadApp = GetObject(, "AutoCAD.Application")
    SetForegroundWindow (acadApp.hwnd)
    SendKeys "XLINK~Import~", True
    SetForegroundWindow (hand)
End Sub

Sub XLsummary()
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Selection.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(1, 4), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub