이미지 만들기 -SAMPLE

 

Sample 코드

Private Sub InsertModelImageIntoExcel()
    Dim swExport As Boolean
    Dim tempImagePath As String
    Dim pic As Picture
    Dim mergedWidth As Double
    Dim mergedHeight As Double
    Dim targetCell As Range
    '// 이미지 삽입
    Set targetCell = WS.Range("E2")
    
    '// 현재 활성화된 문서가 있는지 확인
    If swModel Is Nothing Then
        MsgBox "열려 있는 모델이 없습니다.", vbCritical
        Exit Sub
    End If

    ' 이미지 임시 저장 경로 설정 (BMP 파일)
    tempImagePath = "C:\Temp\ModelImage.jpg"
    
    ' 이미지를 JPG로 내보내기
   swExport = swModel.SaveAs4(tempImagePath, swSaveAsCurrentVersion, swSaveAsOptions_Silent, 0, 0)
   
   
    ' 결합된 셀의 크기 계산
    mergedWidth = targetCell.MergeArea.Width
    mergedHeight = targetCell.MergeArea.Height
    
    Set pic = WS.Pictures.Insert(tempImagePath)
   
   With pic
        .Left = targetCell.MergeArea.Left + 2
        .Top = targetCell.MergeArea.Top + 2
        .Width = mergedWidth - 3
        .Height = mergedHeight - 3
        .Placement = xlMoveAndSize
    End With



    ' 임시 이미지 파일 삭제
    On Error Resume Next
    Kill tempImagePath
    On Error GoTo 0

End Sub

 

 

 

OLE 입력 코드

Sub InsertSolidWorksModelAsOLE()
    Dim swApp As Object
    Dim swModel As Object
    Dim xlSheet As Worksheet
    Dim oleObject As OLEObject
    Dim modelFilePath As String

    ' SolidWorks 앱 객체 설정
    On Error Resume Next
    Set swApp = GetObject(, "SldWorks.Application") ' 이미 실행 중인 SolidWorks 가져오기
    If swApp Is Nothing Then
        MsgBox "SolidWorks가 실행되고 있지 않습니다.", vbCritical
        Exit Sub
    End If
    On Error GoTo 0

    ' 활성화된 모델 가져오기
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "열려 있는 SolidWorks 모델이 없습니다.", vbCritical
        Exit Sub
    End If

    ' 활성화된 모델 파일 경로 가져오기
    modelFilePath = swModel.GetPathName
    If modelFilePath = "" Then
        MsgBox "저장되지 않은 문서는 OLE 삽입이 불가능합니다. 먼저 문서를 저장하세요.", vbCritical
        Exit Sub
    End If

    ' Excel의 활성 워크시트 가져오기
    Set xlSheet = ThisWorkbook.Sheets(1) ' 첫 번째 시트를 선택 (필요에 따라 변경 가능)

    ' OLEObject로 SolidWorks 모델 삽입
    On Error Resume Next
    Set oleObject = xlSheet.OLEObjects.Add( _
        ClassType:="SldWorks.Part", _
        FileName:=modelFilePath, _
        Link:=False, _
        DisplayAsIcon:=False)

    On Error GoTo 0

    ' OLE 삽입 성공 여부 확인
    If oleObject Is Nothing Then
        MsgBox "SolidWorks 모델을 OLE 객체로 삽입하는 데 실패했습니다.", vbCritical
    Else
        MsgBox "SolidWorks 모델이 Excel에 성공적으로 삽입되었습니다!", vbInformation
    End If
End Sub

---