Office: VBA funktioniert auf Windows aber nicht auf Mac

Artischocke · 19. November 2016

Hallo Leute,

ich habe folgendes Problem: die angehängte Datei enthält ein VBA, welches super mit Windows funktioniert, auf dem Mac aber lieder nicht...

Ich bin nicht sehr tief in der Thematik drinnen, könnte mir jemand leicht verständlich erklären, wie ich das VBA anpassen muss?

Wenn ich es laufen lasse, kommt die folgende Fehlermeldung:

Laufzeitfehler "429".:

Objekterstellung durch ActiveX-Komponente nicht möglich.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Lustigerweise funktionieren 2 VBA's aber das Dritte nicht (von xlph geschrieben). Mir geht es um das VBA welches vom Knopf "Filter & Export" gestartet wird ("Modul 1").

Im Anhang eine Datei mit VBA-Element und einigen Testdaten. Falls Irgendwer den Code direkt braucht:
Code:

Option Explicit

Public Sub xlph()

Dim wksSource As Worksheet
Dim wksFilter As Worksheet
Dim wksTarget As Worksheet

Dim lngIndex As Long

Dim objCriteria As Object

Dim vntFilterNr As Variant
Dim vntField As Variant
Dim vntCriteria1 As Variant
Dim vntCriteria2 As Variant

Dim rngTableTargetSheet As Range

Dim objTargetSheets As Object

Dim vntSheetname As Variant

Dim lngLastRow As Long

Dim strTargetSheet As String

Application.ScreenUpdating = False

' Read Criteria-Table

Set objCriteria = CreateObject("scripting.dictionary")

With ThisWorkbook.Worksheets("Filter-Settings")
Call GetHierarchyData(.ListObjects("tboCriteria").DataBodyRange, objCriteria)
Set rngTableTargetSheet = .ListObjects("tboTargetSheet").DataBodyRange
End With

' Read TargetSheets

Set objTargetSheets = CreateObject("scripting.dictionary")

With rngTableTargetSheet
For lngIndex = 1 To .Rows.Count
objTargetSheets(CStr(.Cells(lngIndex, 2).Value)) = 0
Next
End With

' Set Source and Criteria Sheet-Variables

With ThisWorkbook
Set wksSource = .Worksheets("Acc. with Jobs")
Set wksFilter = .Worksheets("Filter")
wksSource.Range("A1").CurrentRegion.Rows(1).Copy _
Destination:=wksFilter.Cells(13, 1)
End With

' Generate TargetSheets and Copy Header

For Each vntSheetname In objTargetSheets
With GetSheet(vntSheetname)
.Cells.Delete
wksSource.Range("A1").CurrentRegion.Rows(1).Copy _
Destination:=.Range("A1")
End With
Next

For Each vntFilterNr In objCriteria.Keys

lngIndex = 0

For Each vntField In objCriteria(vntFilterNr).Keys

' Set Filter-Criteria

lngIndex = lngIndex + 1

wksFilter.Cells(1, lngIndex).Value = vntField
vntCriteria1 = objCriteria(vntFilterNr)(vntField)(0)
vntCriteria2 = objCriteria(vntFilterNr)(vntField)(1)

wksFilter.Cells(2, lngIndex).Value = vntCriteria1

If vntCriteria2 "" Then

lngIndex = lngIndex + 1

wksFilter.Cells(1, lngIndex).Value = vntField
wksFilter.Cells(2, lngIndex).Value = vntCriteria2
End If

Next

' Execute Filter

wksSource.Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wksFilter.Range("A1").CurrentRegion, _
CopyToRange:=wksFilter.Range("A13").CurrentRegion

' Copy Filter-Result to Target-Sheet

strTargetSheet = WorksheetFunction.VLookup(vntFilterNr, rngTableTargetSheet, 2, 0)

With ThisWorkbook.Worksheets(strTargetSheet)

lngLastRow = LastRow(.UsedRange)

wksFilter.Range("A13").CurrentRegion.Offset(1).Copy _
Destination:=.Cells(lngLastRow + 1, 1)

End With

' Clear Filter-Criteria
wksFilter.Range("A1").CurrentRegion.Clear

' Clear Filter-Target
wksFilter.Range("A13").CurrentRegion.Offset(1).Delete

Next

Call Export(ThisWorkbook.Path & "\", objTargetSheets)

Application.ScreenUpdating = True

MsgBox "Finished! Don't forget to clean 'Acc. with Jobs' and delete exported files after every Mapupload!"

Set wksSource = Nothing
Set wksFilter = Nothing
Set wksTarget = Nothing
Set objCriteria = Nothing
Set rngTableTargetSheet = Nothing
Set objTargetSheets = Nothing

End Sub

Public Function LastRow(ByRef rngRange As Range) As Long
On Error Resume Next
LastRow = rngRange.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row
End Function

Private Sub GetHierarchyData(ByRef rngData As Range, ByRef objData As Object)

Dim avntData() As Variant
Dim iavntData As Long

Dim lngFilterNr As Long
Dim strField As String

avntData() = rngData.Value

For iavntData = LBound(avntData) To UBound(avntData)

lngFilterNr = CLng(avntData(iavntData, 1))
strField = CStr(avntData(iavntData, 2))

If Not objData.Exists(lngFilterNr) Then _
Set objData(lngFilterNr) = CreateObject("scripting.dictionary")

objData(lngFilterNr)(strField) = _
Array(avntData(iavntData, 3), avntData(iavntData, 4))

Next

End Sub

Private Function GetSheet(ByVal strSheetname As String) As Worksheet
On Error Resume Next
Set GetSheet = ThisWorkbook.Worksheets(strSheetname)
On Error GoTo 0
If GetSheet Is Nothing Then
With ThisWorkbook
Set GetSheet = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
GetSheet.Name = strSheetname
End With
End If
End Function

Private Function GetIndex(ByRef rngVector As Range, ByVal vntSearchValue As Variant) As Long
On Error Resume Next
GetIndex = WorksheetFunction.Match(vntSearchValue, rngVector, 0)
End Function

Private Sub Export(ByVal strPath As String, ByRef objTargetSheets As Object)
Dim vntItem As Variant
Dim wkb As Workbook
With ThisWorkbook
For Each vntItem In objTargetSheets

'.Worksheets(vntItem).Copy
.Worksheets(vntItem).Move

Set wkb = ActiveWorkbook

Application.DisplayAlerts = False
wkb.SaveAs Filename:=strPath & vntItem & ".xlsx", FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True

wkb.Close SaveChanges:=False

Set wkb = Nothing

Next
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Danke für die Hilfe im Vorraus und liebe Grüße,
die Artischocke

:)

Scorefun · 21. November 2016

Das wird wohl diese Zeile hier sein

Code:

Set objTargetSheets = CreateObject("scripting.dictionary")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das gibt es beim Mac nicht

https://sysmod.wordpress.com/2011/11...ng-dictionary/

Office: VBA funktioniert auf Windows aber nicht auf Mac

VBA funktioniert auf Windows aber nicht auf Mac

VBA funktioniert auf Windows aber nicht auf Mac

VBA funktioniert auf Windows aber nicht auf Mac - Similar Threads - VBA funktioniert Mac

VBA Code " Zeilenhöhe bei Verb. Zellen Funktioniert fasst"

vba .send funktioniert nicht

VBA Code Schliesen nach Zeit X funktioniert nicht

VBA bestimmte Mail Anhänge abspeichern funktioniert nur ab+zu

Stundenzettel, VBA, MoveNext funktioniert nicht

VBA Code Funktioniert nicht

Excel VBA blattschutz Problem