Hallo an alle,
mein Problem ist folgendes.
Ich lese mit VBA bestimmte Werte aus einer Tabelle und übertrage Sie in eine andere (über ein paar Textboxen). So war das früher!
das ist der Code dazu:
with Application
For Each oWorkbook In .Workbooks
If UCase(Left(oWorkbook.name, 5)) = "O_EBR" Then
OeBR = oWorkbook.name
check = True
If ComboBox1.Value = "" Then
MsgBox ("Bitte Schiff wählen")
Else
If ComboBox2.Value = "" Then
MsgBox ("Bitte Monat wählen")
Else
warnung = MsgBox("Im ausgewählten Schiff/Monat werden alle Einträge gelöscht", vbCritical + vbOKCancel)
If warnung = vbOK Then
Load UserForm3
UserForm3.Show
Select Case blatt
Case 1
a = "K27"
b = "N27"
c = "P27"
d = "AQ7"
f1 = "AQ8"
f2 = "AQ9"
f3 = "AQ10"
f4 = "AQ11"
f5 = "AQ12"
g = "AH27"
h = "AJ27"
Case 2
a = "K27"
b = "M27"
c = "O27"
d = "AK7"
f1 = "AK8"
f2 = "AK9"
f3 = "AK10"
f4 = "AK11"
g = "AB27"
h = "AD27"
Case 3
a = "K27"
b = "M27"
c = "O27"
d = "AK7"
f1 = "AK8"
f2 = "AK9"
f3 = "AK10"
f4 = "AK11"
g = "AB27"
h = "AD27"
End Select
Workbooks(OeBR).Activate
aa = ActiveWorkbook.Sheets(blatt).Range(a).Value
bb = ActiveWorkbook.Sheets(blatt).Range(b).Value
cc = ActiveWorkbook.Sheets(blatt).Range(c).Value
dd = ActiveWorkbook.Sheets(blatt).Range(d).Value
ff1 = ActiveWorkbook.Sheets(blatt).Range(f1).Value
ff2 = ActiveWorkbook.Sheets(blatt).Range(f2).Value
ff3 = ActiveWorkbook.Sheets(blatt).Range(f3).Value
ff4 = ActiveWorkbook.Sheets(blatt).Range(f4).Value
If blatt = 1 Then ff5 = ActiveWorkbook.Sheets(blatt).Range(f5).Value
gg = ActiveWorkbook.Sheets(blatt).Range(g).Value
hh = ActiveWorkbook.Sheets(blatt).Range(h).Value
ActiveWindow.Close SaveChanges:=False
CommandButton8.Visible = False
ThisWorkbook.Activate
If wert1 = True Then
If Not aa = "" Then
Me.TextBox1.Value = Round(aa, 1)
Else
Me.TextBox1.Value = ""
End If
End If
If wert2 = True Then
If Not cc = "" Then
Me.TextBox2.Value = Round(cc, 0)
Else
Me.TextBox2.Value = "0"
End If
End If
If wert3 = True Then
If Not dd Then
Me.TextBox3.Value = Round(dd, 0)
Else
Me.TextBox3.Value = ""
End If
End If
If wert4 = True Then
If Not bb = "" Then
Me.TextBox4.Value = Round(bb, 0)
Else
Me.TextBox4.Value = ""
End If
End If
If wert6 = True Then
If gg = "" Then
Me.TextBox6.Value = ""
Else
Me.TextBox6.Value = Round(gg, 0)
End If
End If
If blatt = 1 Then
If wert7 = True Then
If ff1 & ff2 & ff2 & ff4 & ff5 = "" Then
Me.TextBox7.Value = ""
Else
Me.TextBox7.Value = Round(ff1 + ff2 + ff3 + ff4 + ff5, 0)
End If
End If
Else
If wert7 = True Then
If ff1 & ff2 & ff2 & ff4 = "" Then
Me.TextBox7.Value = ""
Else
Me.TextBox7.Value = Round(ff1 + ff2 + ff3 + ff4, 0)
End If
End If
End If
If wert8 = True Then
If Not hh = emty Then
ThisWorkbook.Sheets(Tabelle).Cells(monat, spalte).Value = Round(hh, 5)
seaday_auslesen
Else
Me.TextBox8.Value = ""
End If
End If
End If
End If
End If
Hinbewegen
Exit For
End If
Next
If check = False Then
MsgBox ("Bitte laden sie die Datei ""O_eBR.xls""!")
End If
End With
Ich habe die "original Datei" sprich den Ursprung (O_EBR) über ein Buttom geöffent, das geht jetzt leider nicht mehr. Diese Datei wird jetzt über ein externes Programm geöffent. Diese Programm öffnet eine neu Excel season (das kann auch nicht unterdrückt werden), der Speicherort ist ein sich ändernder Temp Ordner. Die Datei wird also jedes mal neu erstellt und mit Daten aus einer Datenbank gefüllt. Meine Frage ist jetzt wie kann ich diese season (Datei) ansprechen und mir die Werte aus dieser Tabelle holen?
Habe im Netz folgendes gefunden:
Private Declare Function GetDesktopWindow Lib "user32" () _
As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd _
As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" (ByVal hWnd As Long) _
As Long
Private Declare Function GetWindowText Lib "user32" Alias _
"GetWindowTextA" (ByVal hWnd As Long, ByVal lpString _
As String, ByVal cch As Long) As Long
Private Declare Function GetForegroundWindow _
Lib "user32" () As Long
Const GW_HWNDFIRST = 0
Const GW_HWNDNEXT = 2
Dim ExcelTasks, TaskListe
Sub AnzahlExcelTasksNachTitel()
'http://www.activevb.de/tipps/vb6tipps/tipp0123.html
'durchsucht alle (auch unsichtbare) Fenster-Titel, ob darin "Excel" vorkommt.
'So würde zB eine geöffnete Word-Datei namens Excel.doc fälschlich als
'Excel-Task erkannt: Besser daher GetExeNames
Dim hWnd&
ExcelTasks = 0
TaskListe = ""
'Auch der Desktop ist ein Fenster
hWnd = GetDesktopWindow
Call GetWindowInfo(hWnd)
'Einstieg
hWnd = GetForegroundWindow()
hWnd = GetWindow(hWnd, GW_HWNDFIRST)
'Alle vorhandenen Fenster abklappern
Do
Call GetWindowInfo(hWnd)
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop Until hWnd = 0
MsgBox "Diese tasks enthalten Excel im Titel: " & TaskListe & vbCrLf & "Anzahl: " & ExcelTasks
End Sub
Private Sub GetWindowInfo(ByVal hWnd&)
Dim Result&, Title$
Dim a
'Title des Fenster auslesen
Result = GetWindowTextLength(hWnd) + 1
Title = Space$(Result)
Result = GetWindowText(hWnd, Title, Result)
Title = Left$(Title, Len(Title) - 1)
If InStr(Title, "Excel") > 0 Then
TaskListe = TaskListe & vbCrLf & Title
ExcelTasks = ExcelTasks + 1
End If
End Sub
hier wird halt nur der Titel des Fensters geprüft und gezählt (vieleicht kann man damit was anfangen?)
noch ein schnipzel
Public Sub test()
Dim wd
Dim t
Dim L As Long
L = 1
Set wd = CreateObject("Word.Application")
For Each t In wd.Tasks
Cells(L, 1) = t
L = L + 1
Next
wd.Quit
End Sub
hier werden alle laufenden Tasks aufgeführt (eventl. auch eine einstiegsmöäglichkeit)
Leider kann ich aus beiden Sachen nicht machen (da muss ich wohl noch lernen, ich gebe auch zu das ich nicht alles versteh was in diesen Codes steht).
Ich hoffe Ihr könnt mir helfen.
Gruß
Olaf |