Macro auf Apple zum laufen bringen?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Hochformatbilder_einfügen() Dim PicList() As Variant Dim PicFormat As String Dim Rng As Range Dim sShape As Shape On Error Resume Next PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True) xColIndex = Application.ActiveCell.Column If IsArray(PicList) Then xRowIndex = Application.ActiveCell.Row For lLoop = LBound(PicList) To UBound(PicList) Set Rng = Cells(xRowIndex, xColIndex) Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, 106, 158) xRowIndex = xRowIndex + 1 Next End If End Sub

Hallo, :-)
... es nicht testen. Probiere mal. Kann halt Fehler enthalten. ;-)


Option Explicit
Sub Select_File_Or_Files_Mac()
'Select files in Mac Excel with the format that you want
'Working in Mac Excel 2011 and 2016 and higher
'Ron de Bruin, 20 March 2016
Dim MyPath As String
Dim MyScript As String
Dim MyFiles As String
Dim MySplit As Variant
Dim N As Long
Dim Fname As String
Dim mybook As Workbook
Dim OneFile As Boolean
Dim FileFormat As String
Dim img As Picture
'In this example you can only select xlsx files
'See my webpage how to use other and more formats.
FileFormat = "{""org.openxmlformats.spreadsheetml.sheet""}"
' Set to True if you only want to be able to select one file
' And to False to be able to select one or more files
OneFile = True
On Error Resume Next
MyPath = MacScript("return (path to desktop folder) as String")
'Or use A full path with as separator the :
'MyPath = "HarddriveName:Users::Desktop:YourFolder:"
'Building the applescript string, do not change this
If Val(Application.Version)  "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
MySplit = Split(MyFiles, Chr(10))
For N = LBound(MySplit) To UBound(MySplit)
'Get file name only and test if it is open
'Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), _
Application.PathSeparator, , 1))
If bIsBookOpen(Fname) = False Then
'Set mybook = Nothing
On Error Resume Next
'Set mybook = Workbooks.Open(MySplit(N))
Set img = ActiveSheet.Pictures.Insert(MySplit(N))
With img
.Left = ActiveSheet.Range("A8").Left
.Top = ActiveSheet.Range("A8").Top
.Width = 200
.Height = 150
.Placement = 1
.PrintObject = True
End With
On Error GoTo 0
'                If Not mybook Is Nothing Then
'                    MsgBox "You open this file : " & MySplit(N) & vbNewLine & _
'                    "And after you press OK it will be closed" & vbNewLine & _
'                    "without saving, replace this line with your own code."
'                    mybook.Close savechanges:=False
'                End If
Else
MsgBox "We skip this file : " & MySplit(N) & " because it Is already open"
End If
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Kann man dann natürlich noch einkürzen.
Servus
Case

Beliebteste Forumthreads (12 Monate)

Macro auf Apple zum laufen bringen?

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread