AW: Macro nach Macro starten
02.12.2010 15:12:54
Rudi
Hallo Rudi,
ich verstehe nur Bahnhof.
Unten das Macro Urkunde das in Modul 5 steht:
Sub Urkunde_ausdrucken()
Dim MyBox
MyBox = MsgBox("Sind Urkunden im Drucker eingelegt?", vbYesNo)
If MyBox = vbYes Then
'Urkunde öffnen
Worksheets("Urkunde").Activate
ActiveSheet.Unprotect
Dim i As Integer
For i = 11 To 13 Step 1
Range("b42").Select: ActiveCell.Formula = "='Tabelle 1'!bc" & CStr(i) 'Platz
Range("b44").Select: ActiveCell.Formula = "='Tabelle 1'!ak2" 'Was + WK
Range("b46").Select: ActiveCell.Formula = "='Tabelle 1'!by" & CStr(i) 'Name
Range("b48").Select: ActiveCell.Formula = "='Tabelle 1'!bn" & CStr(i) 'Verein
'Druckroutine
'Stop
ActiveWindow.SelectedSheets.PrintOut copies:=1
'Löschroutine
Range("b42").Select: Selection.ClearContents
Range("b44").Select: Selection.ClearContents
Range("b46").Select: Selection.ClearContents
Range("b48").Select: Selection.ClearContents
Next i
'Arbeitsblatt öffnen
Worksheets("Tabelle 1").Activate
'ActiveSheet.Protect
Else
MsgBox "Abbruch"
End If
End Sub
Danach soll das folgende Macro das in Modul 6 steht ausgeführt werden.
Option Explicit
Sub Uebertragen()
Dim oWB_EX As Workbook, varRow
Dim Zeile As Long
Dim booIsOpen As Boolean
Dim rngID As Range, rngPlatz As Range
Dim sDateiZiel As String, sBlattZiel As String
sDateiZiel = "Teilnehmer.xls" 'Name der Zieldatei
sBlattZiel = "Liste" 'Name des Tabellenblattes in der in Zieldatei
'Prüfen, ob Zieldatei geöffnet und setzen von Variablen für Workbook und Offen-Status
Call Check_Open(sDateiZiel, oWB_EX, booIsOpen)
If oWB_EX Is Nothing Then Exit
Sub 'Zieldatei konnte nicht zum Schreiben geöffnet werden.
'Datenbereich
With ThisWorkbook.Sheets("Tabelle 1") 'ggf. Name des Tabellenblatts der Quelldaten anpassen
'beim Anpassen der Zellbereiche darauf achten, dass die Zeilennummern jeweils identisch _
sind.
Set rngPlatz = .Range("bB11:bB15") 'Bereich mit Platz - ggf. anpassen
Set rngID = .Range("be11:be15") 'Bereich mit ID-Nr. - ggf. anpassen
End With
With oWB_EX
With .Sheets(sBlattZiel)
For Zeile = 1 To rngID.Rows.Count
'suche ID aus ID-Bereich in Spalte A (1) der Zieltabelle
varRow = Application.Match(rngID.Cells(Zeile, 1), .Columns(1), 0)
If IsNumeric(varRow) Then 'ID gefunden
'Wert aus Platz-Bereich in Spalte L (12) der Zieltabelle übertragen
.Cells(varRow, 12) = rngPlatz.Cells(Zeile, 1)
End If
Next
End With
.Save 'Ziel-Datei speichern
'Ziel-Datei schliessen, wenn sie nicht geöffnet war
If Not booIsOpen Then
.Close False 'schließen
End If
End With
End Sub
'Hilfsmakro um Datei zu suchen oder zu öffnen
Sub Check_Open(strFileFullName$, ByRef oWB_EX As Workbook, ByRef booIsOpen As Boolean)
Dim strFileName$, oWB As Workbook
strFileName = Right$(strFileFullName, Len(strFileFullName) - InStrRev(strFileFullName, "\"))
For Each oWB In Workbooks
If LCase(oWB.Name) = LCase(strFileName) Then
Set oWB_EX = oWB
End If
Next
If oWB_EX Is Nothing Then
If Dir(strFileFullName) "" Then
Set oWB_EX = Workbooks.Open(strFileFullName)
If oWB_EX.ReadOnly Then
oWB_EX.Close False
Set oWB_EX = Nothing
End If
End If
Else
booIsOpen = True
End If
If Not oWB_EX Is Nothing Then _
If oWB_EX.ReadOnly Then Set oWB_EX = Nothing
If oWB_EX Is Nothing Then
MsgBox "Datei konnte nicht gefunden oder bearbeitet werden.", vbCritical
End If
End Sub
Alle Macros sind von Deinen Kollegen gemacht worden und funktionieren einwandfrei.
Wie ich schon schrieb, Ich habe keine Ahnung von VBA.
Was soll ich mit Deinem wohl sehr gut gemeinten Vorschlag anfangen?
Sub Urkunde_ausdrucken()
'Dein Code
Uebertragen
End Sub
Was soll wohin geschrieben werden? Bitte entchuldige mein Unwissen!
Ich möchte halt einen Arbeitsschritt weniger haben.
Da die beiden Macros die letzten sind, die ich nach getaner Arbeit aufrufe, bin ich der Meinung, dass die auch nacheinander arbeiten können.
Sei bitte so nett und erklähre mir das genau, bitte schreib bei Deinem Code dahinter, was ich hinschreiben soll um es zu verstehen!
Ich habe die Macros so hierher kopiert, wie ich sie im Editor stehen habe!
Gruß Rudi