PDA

Vollständige Version anzeigen : Addin mit Bezug auf ThisWorkbook


fuzzy100fuzzy
12.04.2012, 22:40
Hallo Forumsgemeinde hab da mal wieder ein Problem wo ich nicht weiterkomme. Sorry für die Überschrift mir ist nix besseres eingefallen.

Also:
Ich habe hier ca. 50 Excel Dateien die alle die selben Makros (10Stück) verwenden, im Moment ist es so das die Makros in jeder Datei extra abgespeichert sind. Das Problem ist jetzt wenn ich was an den Makros ändere muss ich bei allen Dateien die Makros bzw. die Module austauschen. Durch etwas Googeln bin ich dann auf ein Addin gestoßen. Hab das auch erstellt und die Entsprechenden Verweise angelegt.

Jetzt bringt mir Ecxel beim ausführen der Makros meistens den Fehler (Index außerhalb des gültigen Bereiches) es Liegt vermutlich daran das ich manche Verweise z.b mit ThisWorkbook.Sheets.... oder (ThisWorkbook.Name).Activate habe ist ja eigentlich logisch das es nicht geht den er sieht dann als ThisWorkbook die Addin Datei an.

Kann ich das irgendwie umgehen? Oder gibt es eine andere Lösungsmöglichkeit?

Hier noch ein bsp: Code aus der Datei damit ersichtlich wird wie die Makros in etwas Aufgebaut sind

Sub Datenholen()

Const strPath As String = "Z:\Ablage\2012\" 'Pfad der Datei
Const strType As String = ".xlsm" ' Datei Typ


'Variablen für Datenübernahme Deklarieren
Dim myDat As Object, rngOut As Range


'Variablen für Dateiname Deklarieren
Dim strName As String
Dim strFullPath As String


' Ausgabebereich
Set rngOut = ThisWorkbook.Sheets("Daten").Range("K14")

' Dateiname aus Zellen holen
With ThisWorkbook.Sheets("Daten")
strName = .Range("E3") & "_" & .Range("F3")
End With

strFullPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\") & strName & strType

If Len(Dir(strFullPath)) Then

'Eingabenbereiche
Set myDat = GetObject(strFullPath).Sheets("Stammdaten").Range("B9")

'Daten Ausgeben
rngOut = myDat


'Stammdaten Datei schließen
GetObject(strFullPath).Close Application.DisplayAlerts = False


'MsgBox bei fehler
Else
MsgBox "Datei nicht gefunden !", vbCritical
End If

End Sub


Viel Dank fürs Lesen

Güße Markus

Hajo_Zi
13.04.2012, 04:58
nicht ThisWorkbook sondern ActiveWorkbook

<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm" onclick="window.open(this.href);return false"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

fuzzy100fuzzy
13.04.2012, 09:03
Vielen Dank Hajo_Zi

für meinen Oben erstellten Code Funktioniert deine Lösung.

Ich habe aber noch andere Codes wo es nicht Funktioniert.

Sub Bestandsverzeichniseintragen()


'Verzeichnis öffnen
Workbooks.Open(Filename:= _
"\\Nas\public\Daten\Bestandsverzeichnis.xlsm").RunAutoMacros Which:= _
xlAutoOpen



'Variable deklarieren
Dim lngletzte1 As Long
Dim Zelle1 As Range
With Worksheets("Verzeichnis")



'********************
'*Name Übertragen
'********************
'Zu Aktuellen Stammblatt wechseln
Windows(ThisWorkbook.Name).Activate
Sheets("Stammdaten - Eingabe").Select

'Zellenbereich für Geb.Datum Makieren
Sheets("Stammdaten - Eingabe").Select
Range("B16").Select


For Each Zelle1 In Selection
'erste freie Zeile B:
Windows("Bestandsverzeichnis.xlsm").Activate
Sheets("Verzeichnis").Select

lngletzte1 = Sheets("Verzeichnis").Cells(Rows.Count, 1).End(xlUp).Row + 1
'Spalte A, übertragen
.Cells(lngletzte1, "A").Value = Zelle1.Value
Next


'********************
'*Nummer Übertragen
'********************

'Zu Aktuellen Stammblatt wechseln
Windows(ThisWorkbook.Name).Activate
Sheets("Stammdaten - Eingabe").Select


'Zellenbereich für Datum Makieren
Sheets("Stammdaten - Eingabe").Select
Range("B17").Select


For Each Zelle1 In Selection
'erste freie Zeile B:
Windows("Bestandsverzeichnis.xlsm").Activate
Sheets("Verzeichnis").Select

lngletzte1 = Sheets("Verzeichnis").Cells(Rows.Count, 2).End(xlUp).Row + 1
'Spalte B, übertragen
.Cells(lngletzte1, "B").Value = Zelle1.Value
Next

'************************
'Bestandsverzeichnis speichern
'***********************


ThisWorkbook.Save
ThisWorkbook.Close






End With


der Code soll folgendes Bewirken:
Er soll mir 2 Daten aus einer Stammdatei in ein Verzeichnis eintragen.

Ich weiß nicht ob das was bringt aber mann könnte den Aktuellen Stammdateinmen die geöffnet ist aus zwei Zellen zusammensetzten die Dateinamen setzten sich immer aus Name_Nummer zusammen der Name und Nummer würden sich in ("Stammdaten - Eingabe") befinden Name in B4 und Nummer in B5.

Vielen Dank fürs Lesen

Gruß Markus

losgehts
13.04.2012, 09:42
Hallo,

beim Umgang mit mehreren Dateien lohnt es sich meistens, Variablen für diese zu benutzen.

Hier einmal ein Code (ohne "select" und activate"):Sub Bestandsverzeichniseintragen()
'Variable deklarieren
Dim lngletzte1 As Long
Dim Zelle1 As Range
Dim WbBestand As Workbook
Dim WbAkt As Workbook

'Aktive Datei
Set WbAkt = ActiveWorkbook

'Verzeichnis öffnen
Workbooks.Open(Filename:= _
"\\Nas\public\Daten\Bestandsverzeichnis.xlsm").RunAutoMacros Which:= _
xlAutoOpen

'Bestandsdatei
Set WbBestand = ActiveWorkbook


'********************
'*Name Übertragen
'********************
'erste freie Zeile A:
lngletzte1 = WbBestand.Sheets("Verzeichnis").Cells(Rows.Count, 1).End(xlUp).Row + 1

WbBestand.Sheets("Verzeichnis").Cells(lngletzte1, "A").Value = WbAkt.Sheets("Stammdaten - Eingabe").Range("B16").Value


'********************
'*Nummer Übertragen
'********************
'erste freie Zeile B:
lngletzte1 = WbBestand.Sheets("Verzeichnis").Cells(Rows.Count, 2).End(xlUp).Row + 1

'Spalte B, übertragen
WbBestand.Sheets("Verzeichnis").Cells(lngletzte1, "B").Value = WbAkt.Sheets("Stammdaten - Eingabe").Range("B17").Value



'************************
'Bestandsverzeichnis speichern
'***********************
WbBestand.Save
WbBestand.Close
Set WbBestand = Nothing
Set WbAkt = Nothing



Und nochmal der gleiche Code, diesmal unter der (sinnvollen :p ) Verwendung von "with".Sub Bestandsverzeichniseintragen()
'Variable deklarieren
Dim lngletzte1 As Long
Dim Zelle1 As Range
Dim WbBestand As Workbook
Dim WbAkt As Workbook

'Aktive Datei
Set WbAkt = ActiveWorkbook

'Verzeichnis öffnen
Workbooks.Open(Filename:= _
"\\Nas\public\Daten\Bestandsverzeichnis.xlsm").RunAutoMacros Which:= _
xlAutoOpen

'Bestandsdatei
Set WbBestand = ActiveWorkbook


With WbBestand.Worksheets("Verzeichnis")

'********************
'*Name Übertragen
'********************
'erste freie Zeile A:
lngletzte1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1

.Cells(lngletzte1, "A").Value = WbAkt.Sheets("Stammdaten - Eingabe").Range("B16").Value


'********************
'*Nummer Übertragen
'********************

'erste freie Zeile B:
lngletzte1 = .Cells(Rows.Count, 2).End(xlUp).Row + 1

'Spalte B, übertragen
.Cells(lngletzte1, "B").Value = WbAkt.Sheets("Stammdaten - Eingabe").Range("B17").Value

End With


'************************
'Bestandsverzeichnis speichern
'***********************
WbBestand.Save
WbBestand.Close
Set WbBestand = Nothing
Set WbAkt = Nothing

Beide Codes habe ich nicht getestet.

Grüße, Ulrich

fuzzy100fuzzy
13.04.2012, 11:16
Vielen Dank losgehts,

beide Code´s Funktionieren Einwandfrei hab jetzt Variante 2 genommen

nochmal besten Dank

Grüße Markus

fuzzy100fuzzy
13.04.2012, 12:09
Hallo,

jetzt muss ich Leider noch einmal eine Frage Stellen zum Thema Add-In.

Hab mir jetzt ein Addin mit meinen benötigten Makros erstellt und die Addin Datei im ordner C:\Users\MarkusG\AppData\Roaming\Microsoft\AddIns
abgelegt.

Hab das Addin auch so eingebunden das es beim Starten der Datei mit geöffnet wird.
Nur muss ich jetzt jedes mal im VBA Editor den Verweis auf die Addin Datei neu anlegen kann man das irgendwie Automatisch machen z.b. mit einem VBA Code?

Vielen Dank

Gruß Markus

fuzzy100fuzzy
13.04.2012, 18:38
Das Problem hat sich erledigt ich hatte nur einen Simplen Zuordnungsfehler der Button´s.

Manchmal sieht man den Wald vor lauter Bäumen nicht