Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1012to1016
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Datei öffnen, befüllen und speichern
07.10.2008 11:36:05
Benny
Hi,
wie kann man folgendes Problem umsetzen?
Wenn in Datei "CR6Projekt.xls" von B6 bis B60 irgendein Feld aktiviert wird, also ein Name eingegeben wird soll in der Zeile dann z.B. C6, D6, F6 und G6 in bestimmte Felder B8, B10, D10 und F10 einer anderen Datei "ÄnderungsA.xls" übernommen werden. Diese Datei "ÄnderungsA.xls" soll mit drücken eines Button geöffnet werden und mit dem Namen des Feldes B8 (der Datei "ÄnderungsA.xls") in einem bestimmten Pfad gespeichert werden.
Bin hier überfordert. Bitte helft mir! Wär echt klasse!
Gruß Benny

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datei öffnen, befüllen und speichern
07.10.2008 16:09:50
fcs
Hallo Benny,
der von dir beschriebene Ablauf ist etwas schwierig zu realisieren.
Ich kann dir folgendes anbieten:
Bei einer Änderung in Spalte B wird die Datei "ÄnderungsA.xls" geöffnet und die Daten übertragen.
Solange die Datei "ÄnderungsA.xls" geöffnet ist, werden Änderungen in der gleichen Zeile übertragen.
Per Button-Klick (Button aus Symbolleiste "Steuerelement-Toolbox") wird die datei unter neuem Namen gespeichert.
Den Code muss du in der Datei "CR6Projekt.xls" im VBA-Editor unter der Tabelle speichern, in der die Einagen überwacht werden sollen.
Gruß
Franz

Private wbAenderung As Workbook, wksAenderung As Worksheet, lngZeile As Long
'Nachfolgende Pfade und Dateinamen anpassen
Private Const strPfadAenderung As String = "C:\Lokale Daten\test"
Private Const strDateiAenderung As String = "ÄnderungA.xls"
Private Const strPfad As String = "C:\Lokale Daten\test\Daten" 'Zielverzeichnis für neue  _
Dateien
Private Sub CommandButton1_Click()
'Änderungsdatei speichern
On Error GoTo Fehler
If wbAenderung Is Nothing Then
MsgBox "Es wurden noch keine Daten in Spalte B geändert!"
Else
wbAenderung.Activate
If MsgBox(Prompt:="Datei mit Daten zu Zeile " & lngZeile & " speichern?" & vbLf _
& "Dateiname: " & strPfad & "\" & wksAenderung.Range("B8").Text, _
Buttons:=vbYesNo) = vbYes Then
wbAenderung.SaveAs Filename:=strPfad & "\" & wksAenderung.Range("B8").Text
wbAenderung.Close
Set wksAenderung = Nothing
Set wbAenderung = Nothing
Else
ThisWorkbook.Activate
End If
End If
Fehler:
If Err.Number  0 Then
MsgBox "Fehler nr. " & Err.Number & vbLf & Err.Description
ThisWorkbook.Activate
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B6:F60")) Is Nothing And Target.Cells.Count = 1 Then
Select Case Target.Column
Case 2
'Case 2, bei Änderungen eines Werts in Spalte 2, wird Änderungsdatei schreibgeschützt geöffnet  _
_
oder neu zugewiesen falls schon geöffnet
If Not IsEmpty(Target) Then
If CheckWorkbookOpen(strDateiAenderung) = True Then
'Änderungsdatei ist schon geöffnet
Set wbAenderung = Workbooks(strDateiAenderung)
Else
'Änderungsdatei schreibgeschützt öffnen
Set wbAenderung = Workbooks.Open(Filename:=strPfadAenderung & "\" &  _
strDateiAenderung, _
ReadOnly:=True)
End If
'Tabellenblatt in Änderungsdatei setzen
Set wksAenderung = wbAenderung.Worksheets(1)
ThisWorkbook.Activate
'geänderte Zeile merken
lngZeile = Target.Row
'Daten in Änderungsdatei übertragen
wksAenderung.Range("B8") = Me.Cells(lngZeile, 3)
wksAenderung.Range("D10") = Me.Cells(lngZeile, 4)
wksAenderung.Range("E10") = Me.Cells(lngZeile, 5)
wksAenderung.Range("F10") = Me.Cells(lngZeile, 6)
End If
'Case 3 bis 6 übertragen Änderungen in den Spalten, wenn diese in der gemerkten Zeile erfolgen
Case 3
If Target.Row = lngZeile And Not wbAenderung Is Nothing Then
wksAenderung.Range("B8") = Target.Value
End If
Case 4
If Target.Row = lngZeile And Not wbAenderung Is Nothing Then
wksAenderung.Range("D10") = Target.Value
End If
Case 5
If Target.Row = lngZeile And Not wbAenderung Is Nothing Then
wksAenderung.Range("E10") = Target.Value
End If
Case 6
If Target.Row = lngZeile And Not wbAenderung Is Nothing Then
wksAenderung.Range("F10") = Target.Value
End If
Case Else
'do nothing
End Select
End If
End Sub
Private Function CheckWorkbookOpen(strName As String) As Boolean
'Prüfen, ob Arbeitsmappe strName schon geöffnet ist
Dim wb As Workbook
CheckWorkbookOpen = False
For Each wb In Workbooks
If UCase(wb.Name) = UCase(strName) Then
CheckWorkbookOpen = True
Exit For
End If
Next
End Function


Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige