Hallo.
Aus internen Gründen müssen wir ein Stück Excel-Tabelle in unsere Zeichnungen einfügen.
Alles läuft reibungslos, aber beim Öffnen der Dateien haben wir diese Sicherheitsmeldung. (siehe PC)
Gibt es eine Möglichkeit, diese Meldung zu umgehen, so dass sie nicht mehr erscheint, weil sie unsere automatischen Konvertierungsaufgaben über EPDM oder MYCADTOOL blockiert?
Vielen Dank im Voraus für Ihre Erleuchtung.
A. Mendes
Hallo;
Diese Art von Meldung ist Excel-Makrowarnungen sehr ähnlich. Wäre da nicht etwas in Ihrer Tabelle, das Sie kopieren könnten?
Wie machst du das Kleben? durch OLE-Objekte oder durch einfaches Kopieren und Einfügen?
Die untergeordnete Frage lautet: Haben Sie eine bedingte Formatierung in Ihrem Excel?
Ist es nicht möglich, anstelle dieses gemeldeten Dokuments eine Allgemeine Tabelle zu verwenden?
Wenn Sie interessiert sind, habe ich ein Makro (Solidworks), um Excel-Zellen in Form einer neuen Tabelle in MEPs zu importieren.
Herzliche Grüße.
Hello@Mclane
Meine Collage wird durch einfaches Kopieren und Einfügen erstellt, das automatisch ein OLE-Objekt für mich generiert.
Ja, bedingte Formatierung in der Tabelle.
Für die Implementierung einer allgemeinen Tabelle, warum nicht nur, wenn sie per Makro erfolgt. Also bin ich schließlich ein Nehmer.
Vielen Dank, dass Sie sich mit dem Thema befasst haben.
A. Mendes
Ich habe gerade mein Makro im vorherigen Beitrag zur Verfügung gestellt.
Hier ist der Code....
' Prerequis: Une Mise en plan Solidworks est ouverte, Un excel est ouvert et la zone à importer est selectionnée.
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
ImportTable swDraw
End Sub
Sub ImportTable(drawingSheet As SldWorks.DrawingDoc)
Dim swTable As SldWorks.TableAnnotation
Dim swAnn As SldWorks.Annotation
Dim nNumCol As Long
Dim nNumRow As Long
Dim sRowStr As String
Dim i As Long
Dim j As Long
Dim objExcelObject As Excel.Application
Dim objBook1 As Excel.Workbook
Dim objSheet1 As Excel.Worksheet
Dim iRows As Integer
Dim iCols As Integer
Dim sBase As String
MsgBox ("Ouvrez un fichier Excel,et selectionnez les cellules à importer." & Chr(10) & "...." & Chr(10) & "Cliquez sur 'OK' pour debuter l'importation.")
Set objExcelObject = GetObject(, "Excel.Application")
If objExcelObject Is Nothing Then
MsgBox "Un fichier Excel doit être ouvert." & Chr(10) & "Fin de la macro."
Else
iRows = objExcelObject.Selection.Rows.Count
iCols = objExcelObject.Selection.Columns.Count
sBase = objExcelObject.Selection.Cells(1, 1).Address
Dim sWidth As Double
Dim sHeight As Double
drawingSheet.GetCurrentSheet().GetSize sWidth, sHeight
Set swTable = drawingSheet.InsertTableAnnotation2(False, 0, sHeight, swBOMConfigurationAnchor_TopLeft, "", iRows, iCols)
For i = 0 To iRows - 1
Dim cell As Range
For j = 0 To iCols - 1
Set cell = objExcelObject.Selection.Range("A1").Offset(i, j)
If i = 0 Then
' Definition des largeurs de colonnes
swTable.SetColumnWidth j, cell.ColumnWidth * 7.5 / 4000, swTableRowColChange_TableSizeCanChange
End If
' Definition du format des cellules
Dim tf As TextFormat
Set tf = swTable.GetTextFormat
tf.Bold = cell.Font.Bold
tf.Strikeout = cell.Font.Strikethrough
tf.Italic = cell.Font.Italic
If cell.Font.Underline > 0 Then tf.Underline = True
tf.CharHeightInPts = cell.Font.Size
' Definition du format du texte
swTable.SetCellTextFormat i, j, False, tf
' Alignement des cellules
swTable.CellTextHorizontalJustification(i, j) = Switch(cell.HorizontalAlignment = XlHAlign.xlHAlignRight, swTextJustificationRight, cell.HorizontalAlignment = XlHAlign.xlHAlignCenter, swTextJustificationCenter, True, swTextJustificationLeft)
swTable.CellTextVerticalJustification(i, j) = Switch(cell.VerticalAlignment = XlVAlign.xlVAlignBottom, swTextAlignmentBottom, cell.VerticalAlignment = XlVAlign.xlVAlignCenter, swTextAlignmentMiddle, True, swTextAlignmentTop)
swTable.Text(i, j) = cell
Next j
' Definition des Hauteur de colonnes
swTable.SetRowHeight i, cell.RowHeight / 0.75 / 4000, swTableRowColChange_TableSizeCanChange
Next i
End If
Set objSheet1 = Nothing
Set objBook1 = Nothing
Set objExcelObject = Nothing
End Sub
@Mclane
Vielen Dank. Ich werde versuchen, mich so schnell wie möglich mit dem Thema auseinanderzusetzen, aber im Moment bin ich mit der Arbeit überfordert.
Wenn Sie in der Zwischenzeit leider eine Lösung für die Nachricht finden, bin ich immer interessiert.