Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1488to1492
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
Inhaltsverzeichnis

Formularinhalt mehrfach hintereinander abfüllen

Formularinhalt mehrfach hintereinander abfüllen
20.04.2016 09:33:25
Kina
Hallo zusammen,
Ich fülle über ein Formular verschiedene Daten in unterschiedliche Exel Files ab.
Der Code zum abfüllen in File abc sieht wie folgt aus und funktioniert im Einzelfall soweit einwandfrei:
If Me.cbbOriginal.Value = "YES" Then
Workbooks.Open Filename:= _"G:\...\...\abc.xlsx"Windows("abc.xlsx").Activate
Set wkbKontakt = ActiveWorkbook
Set wksKontakt = wkbKontakt.Sheets("PENDING")
Rows("5:5").Select
Selection.Insert Shift:=xlDown
With Me.txtDate
If .Value "" Then wksKontakt.Range("B5").Value = Me.txtDate.Value
End With
With Me.txtReason
If .Value "" Then wksKontakt.Range("E5").Value = Me.txtReason.Value
End With
End If
Das Problem taucht jedoch auf, wenn ich mehrere Formulare hintereinander in abc.xlsx abfüllen will. Dann kriege ich aufgrund der Tatsache dass abc.xlsx schon offen ist eine Fehlermeldung die besagt, dass alle Änderungen im File verloren gehen, wenn ich das File neu öffne. Weiss jemand wie ich das Problem beheben kann?
Vielen Dank
Kina

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Formularinhalt mehrfach hintereinander abfüllen
20.04.2016 10:06:43
ChrisL
Hi Kina
Du kannst eine Prüfung einbauen, ob eine Datei bereits geöffnet ist. Nachfolgender Code bedingt dann aber, dass die Variablen bei geöffneter Datei bereits definiert wurden.
ungetestet:
Sub t()
Const sDatei As String = "G:\...\...\abc.xlsx"
Dim wkbKontakt As Workbook, wksKontakt As Worksheet
If Me.cbbOriginal.Value = "YES" Then
If Not IsWorkbookOpen(sDatei) Then
Set wkbKontakt = Workbooks.Open(sDatei)
Set wksKontakt = wkbKontakt.Sheets("PENDING")
End If
With wksKontakt
.Rows("5:5").Insert Shift:=xlDown
If Me.txtDate.Value  "" Then .Range("B5").Value = Me.txtDate.Value
If Me.txtReason.Value  "" Then .Range("E5").Value = Me.txtReason.Value
End With
End If
End Sub

Function IsWorkbookOpen(strWB As String) As Boolean
' Quelle: http://www.office- _
loesung.de/ftopic118311_0_0_asc.php
On Error Resume Next
IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function

Die Problemstellung sollte eigentlich gesamtheitlich angegangen werden, so dass es gar nicht erst zu Konflikten kommt d.h. im Codeablauf müsste bekannt sein, ob die Datei bereits geöffnet ist oder nicht.
cu
Chris

Anzeige
Formularinhalt mehrfach hintereinander abfüllen
20.04.2016 10:42:57
Kina
Hallo Chris,
Ich habe es mit der ersten Variante probiert, kriege jedoch die Fehlermeldung Fehler beim _ Kompilieren: End

Sub erwartet.
Habe auch den 2. Ansatz probiert, aber warscheinlich falsch in meinen Code eingefühgt. Wie mü _
sse der ganze Code (in meinen integriert) lauten?
If Me.cbbOriginal.Value = "YES" Then
Workbooks.Open Filename:= _"G:\...\...\abc.xlsx"Windows("abc.xlsx").Activate

Function IsWorkbookOpen(strWB As String) As Boolean
' Quelle: http://www.office-
_
loesung.de/ftopic118311_0_0_asc.php
On Error Resume Next
IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function

Set wkbKontakt = ActiveWorkbook
Set wksKontakt = wkbKontakt.Sheets("PENDING")
Rows("5:5").Select
Selection.Insert Shift:=xlDown
With Me.txtDate
If .Value "" Then wksKontakt.Range("B5").Value = Me.txtDate.Value
End With
With Me.txtReason
If .Value "" Then wksKontakt.Range("E5").Value = Me.txtReason.Value
End With
End If
Hat nicht funktioniert...
Danke und liebe Grüsse

Anzeige
AW: Formularinhalt mehrfach hintereinander abfüllen
20.04.2016 11:05:45
ChrisL
Hi Kina
Eigentlich musst du den Code wie er steht Copy/Pasten d.h. Prozedur (Sub) und Funktion (Function) stehen separat im gleichen Modul. Den ursprünglichen Code habe ich dir übrigens noch aufgeräumt.
Beim Quellenverweis hat das Forum etwas gestreikt, war auch nur informativ, kannst weglassen.
Sub t()
Const sDatei As String = "G:\...\...\abc.xlsx"
Dim wkbKontakt As Workbook, wksKontakt As Worksheet
If Me.cbbOriginal.Value = "YES" Then
If Not IsWorkbookOpen(sDatei) Then
Set wkbKontakt = Workbooks.Open(sDatei)
Set wksKontakt = wkbKontakt.Sheets("PENDING")
End If
With wksKontakt
.Rows("5:5").Insert Shift:=xlDown
If Me.txtDate.Value  "" Then .Range("B5").Value = Me.txtDate.Value
If Me.txtReason.Value  "" Then .Range("E5").Value = Me.txtReason.Value
End With
End If
End Sub
Function IsWorkbookOpen(strWB As String) As Boolean
On Error Resume Next
IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige