AW: @Sepp
18.03.2009 20:11:13
Josef
Hallo Fritz,
du must unter Excel-Optionen > Vertrtauenststellungscenter > Einstellungen für das Vertrauenstellungscenter > Einstellungen für Makros > den Zugriff auf ads VBA-Projekt genehmigen.
Der angepasste Code sieht so aus.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub copyMe()
Dim objWB As Workbook
Dim vbComp As Object
Dim rng As Range
Dim strSave As String, strExt As String, strSaveXLSM As String, intCnt As Integer
On Error GoTo ErrExit
GMS
For Each rng In ThisWorkbook.Sheets("Tabelle1").Range("A1:A20")
If rng <> "" Then
intCnt = intCnt + 1
Application.StatusBar = "Speichern von Datei " & CStr(intCnt) & " / " & rng.Text & Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "."))
strSave = ThisWorkbook.Path & "\" & rng.Text & Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "."))
ThisWorkbook.SaveCopyAs strSave
Set objWB = Workbooks.Open(strSave)
With objWB
With .Sheets("Tabelle1")
.Range("A1:A20").ClearContents
.Range("A1") = rng
.Rows(1).Hidden = True
End With
For Each vbComp In .VBProject.vbcomponents
If vbComp.Type = 100 Then
With .VBProject.vbcomponents(vbComp.Name).CodeModule
.DeleteLines 1, .CountOfLines
End With
Else
.VBProject.vbcomponents.Remove vbComp
End If
Next
strExt = Mid(strSave, InStrRev(strSave, "."))
If Len(strExt) > 4 Then strExt = Left(strExt, 4) & "x"
strSaveXLSM = Left(strSave, InStrRev(strSave, ".") - 1)
strSaveXLSM = strSaveXLSM & strExt
objWB.SaveAs strSaveXLSM, FileFormat:=IIf(Len(strExt) = 5, 51, -4143)
objWB.Close
Kill strSave
End With
End If
Next
ErrExit:
With Err
If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
.Description & vbLf & vbLf & "In Prozedur (copyMe) in Modul Modul1", _
vbExclamation, "Fehler in Modul1 / copyMe"
End With
GMS True
End Sub
Public Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
.StatusBar = False
End With
End Sub
Gruß Sepp