Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

makro anpassen

Betrifft: makro anpassen
von: Joachim
Geschrieben am: 14.04.2003 - 12:58:17

Hallo,

ich habe folgendes Makro hier im Archiv gefunden:

--------------------------------------------------------------
Sub Multiopen()
Dim arrFilenames As Variant
Dim wkbArr As Workbook
Dim wkbBasis As Workbook
Set wkbBasis = ActiveWorkbook

Selection:
' Zu öffnende Dateien erfragen
arrFilenames = Application.GetOpenFilename( _
"Exceldateien (*.xls), *.xls, Alle Dateien (*.*), *.*", 1, _
"Exceldateien auswählen...", MultiSelect:=True) ' Ausgewählte Dateien des Öffnen-Dialoges in Feld ablegen
If VarType(arrFilenames) = vbBoolean Then
If MsgBox("Sie haben keine Dateien ausgewählt. Möchten sie das Makro beenden?", vbYesNo, "Frage") = vbNo Then
GoTo Selection
Else
Set wbkBasis = Nothing
Exit Sub
End If
End If

Application.ScreenUpdating = False
'Die vom Makro vorgenommenen Tätigkeiten
'bleiben zur Geschwidigkeitssteigerung unsichtbar

For i = 1 To UBound(arrFilenames) ' Durchläuft die Anzahl der Dateien
'Wenn Datei noch nicht geöffnet
If FileOpenYet(DIR$(arrFilenames(i))) = False Then
'dann öffnen
Workbooks.Open FileName:=arrFilenames(i)
Else
'oder aktivieren
Workbooks(DIR$(arrFilenames(i))).Activate
End If
Set wkbArr = ActiveWorkbook
'-------------------------------------------------------
'hier kommt dann der Code rein, der die ausgewählten Dateien
'betrifft. Die Ursprungsdatei ist über wbkBasis ansprechbar.
wkbBasis.Worksheets(1).Cells(i, 1).value = wkbArr.Worksheets(1).Range("B1").value
wkbBasis.Worksheets(1).Cells(i, 2).value = wkbArr.Worksheets(2).Range("C34").value
wkbBasis.Worksheets(1).Cells(i, 3).value = wkbArr.Worksheets(3).Range("S32").value
wkbArr.Close SaveChanges:=False 'Datei schließen
Set wkbArr = Nothing
'-------------------------------------------------------
Next i
Set wkbArr = Nothing
'Ursprüngliche Datei wieder aktivieren
wkbBasis.Activate
Set wkbBasis = Nothing 'Die Variable zurücksetzen
'und den Monitor aktivieren
Application.ScreenUpdating = True
End Sub


Function FileOpenYet(FileName As String) As Boolean
'eine Funktion, die Prüft ob eine Datei schon geöffnet ist.
Dim s As String
On Error GoTo Nonexistent
s = Workbooks(FileName).name
FileOpenYet = True
Exit Function
Nonexistent:
FileOpenYet = False
End Function


--------------------------------------------------------------------------------

Dieses öffnet ein bestehendes Excel File und kopiert die Inhalte bestimmter Zellen in, wiederum fest bestimmbare, Zellen des aktuellen Worksheets.
Die Problemstellung, die ich lösen möchte ist ganz ähnlich wie die im obigen Makro durchgeführte Lösung.
Allerdings möchte jeweils nebeneinanderliegende Spalten von einem bestehenden File das aktuelle worksheet kopieren. Hierbei möchte ich gern auswählen können, welche Spalten ich kopieren möchte. Also in der Art: "Welche Spalten möchten Sie kopieren?" -> C und D ....
Leider bin ich absoluter Anfänger im Bereich von VBS und wäre echt dankbar, wenn Ihr Euch meines Problemchens annehmen könntet!

Danke Jo


  

doppelt (o.T.)
von: Carsten
Geschrieben am: 14.04.2003 - 13:00:22



  

Re: doppelt (o.T.)
von: Joachim
Geschrieben am: 14.04.2003 - 13:04:02

beim ersten mal hab ich auf VORSCHAU geklickt!!! Warum das dann zweimal kam weiss ich auch ned - wohl ein Fehler meinerseits! Jedenfalls wollt ich es nur einmal mailen.

 

Beiträge aus den Excel-Beispielen zum Thema "makro anpassen"