Microsoft Excel

Herbers Excel/VBA-Archiv

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

Dateneingabe ohne Userform

Betrifft: Dateneingabe ohne Userform von: Maiks
Geschrieben am: 08.06.2008 18:06:31

Hallo zusammen,

ich möchte Daten von bestimmten Zelle einer Excel-Datei mit klick einem Button in andere Excel-Datei eintragen ohne Userform.
Tagelang bin ich auf der Suche nach änhlichem VBA-Code. habe ich endlich etwas gefunden. Leider dieser Code trägt die Daten in dieselbe Excel-Datei und in dieselbe Excel-Tabelle.
ich brauche aber die Daten in andere Excel-Datei (mit Filename: Preisliste.xls) . diese File steht auf

C:\Artikelliste\Preisliste.xls

und dieser Code soll die Daten in der Tabelle1 ab Zeile A3 der excel-Datei Preisliste.xls eintragen.

mein Problem ist: ich weiss nicht wie meinem neuen Pfad in dem Code, der gefunden habe, schreiben soll.

hier ist der Code, die ich am Net gefunden habe:

https://www.herber.de/bbs/user/52931.xls

für jede Hilfe bin ich euch sehr dankbar
Maik

  

Betrifft: AW: Dateneingabe ohne Userform von: Daniel
Geschrieben am: 08.06.2008 18:28:18

Hi

so müsstest du den Code abändern, wenn die Daten in eine ander Datei übertragen werden sollen.
die Datei muss aber geöffnet sein, sonst gehts nicht.

'######################################################
'# #
'# Diese Makros stammen von Bert Körn #
'# E-Mail: berti@excelabc.de #
'# Homepage: http://www.excelabc.de #
'# #
'######################################################

Option Explicit

Sub Daten_eintragen()
  Dim Zeile
  'nur wenn in B3 und D3 etwas drinsteht dann eintragen
  If [b3] <> "" And [d3] <> "" Then
    'Blattschutz aufheben
    With Workbooks("Preisliste.xls").Sheets("Tabelle1")
        'letzte benutzte Zeile ermitteln + 1
        Zeile = .Cells(Rows.Count, 1).SpecialCells(xlLastCell).Row + 1
        'Daten eintragen
        .Cells(Zeile, 1) = [b3]
        .Cells(Zeile, 2) = [d3]
        .Cells(Zeile, 3) = [b5]
        .Cells(Zeile, 4) = [d5]
        .Cells(Zeile, 5) = [b7]
        .Cells(Zeile, 6) = [d7]
        .Cells(Zeile, 7) = [b9]
        .Cells(Zeile, 8) = [d9]
        .Cells(Zeile, 9) = [b11]
        .Cells(Zeile, 10) = [d11]
        .Cells(Zeile, 11) = [b13]
        .Cells(Zeile, 12) = [d13]
        'Eingaben löschen
        [b3:b13] = ""
        [d3:d13] = ""
      end with
  Else
    MsgBox "Bitte Namen eintragen"
  End If
  'Blattschutz aktivieren
  
End Sub



Gruß, Daniel


  

Betrifft: AW: Dateneingabe ohne Userform von: Josef Ehrensberger
Geschrieben am: 08.06.2008 18:29:12

Hallo Maik,

ändere das Makro mal um. (ungetestet!)

Sub Daten_eintragen()
Dim objWb As Workbook, objSh As Worksheet, objThisSheet As Worksheet
Dim strFile As String
Dim Zeile

On Error GoTo ErrExit

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

strFile = "C:\Artikelliste\Preisliste.xls" 'Datei in die geschrieben wird - Anpassen!

Set objThisSheet = ThisWorkbook.Sheets("Tabelle1") 'Tabellenblatt mit dem Formular - Anpassen!
Set objWb = Workbooks.Open(strFile)
Set objSh = objWb.Sheets("Tabelle1") 'Tabelle in die geschrieben wird - Anpassen!

Zeile = Application.Max(objSh.Cells(Rows.Count, 1).End(xlUp).Row + 1, 3)

'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
    If .[b3] <> "" And .[d3] <> "" Then
        
        'Daten eintragen
        objSh.Cells(Zeile, 1) = .[b3]
        objSh.Cells(Zeile, 2) = .[d3]
        objSh.Cells(Zeile, 3) = .[b5]
        objSh.Cells(Zeile, 4) = .[d5]
        objSh.Cells(Zeile, 5) = .[b7]
        objSh.Cells(Zeile, 6) = .[d7]
        objSh.Cells(Zeile, 7) = .[b9]
        objSh.Cells(Zeile, 8) = .[d9]
        objSh.Cells(Zeile, 9) = .[b11]
        objSh.Cells(Zeile, 10) = .[d11]
        objSh.Cells(Zeile, 11) = .[b13]
        objSh.Cells(Zeile, 12) = .[d13]
        'Eingaben löschen
        .[b3:b13] = ""
        .[d3:d13] = ""
        
    Else
        MsgBox "Bitte Namen eintragen"
    End If
End With

objWb.Close True

ErrExit:

If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Set objWb = Nothing
Set objSh = Nothing
Set objThisSheet = Nothing
End Sub




Gruß Sepp





  

Betrifft: AW: Dateneingabe ohne Userform von: Maiks
Geschrieben am: 08.06.2008 18:59:56

Hallo Daniel, Hallo Sepp,

vielen dank für euer schnelle Anworten
ich habe die beide Code getestet.

erst von Daniel: ich habe folgende Fehlermeldung:



danach habe ich auch den Code von Sepp getestet: der Code trägt die Datei ein, leider habe ich ad auch zwei fehler
erst: die Zelle D3 bis D13 werden nicht leer.

zweite: die Fehlermeldung




vielen dank im voraus.
Maiks


  

Betrifft: AW: Dateneingabe ohne Userform von: Josef Ehrensberger
Geschrieben am: 08.06.2008 19:03:42

Hallo Maik,

die Fehlermeldung sagt doch schon woran es liegt, dein Blatt ist geschützt.

Nimm diesen Code.

Sub Daten_eintragen()
Dim objWb As Workbook, objSh As Worksheet, objThisSheet As Worksheet
Dim strFile As String
Dim Zeile

On Error GoTo ErrExit

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

strFile = "C:\Artikelliste\Preisliste.xls" 'Datei in die geschrieben wird - Anpassen!

Set objThisSheet = ThisWorkbook.Sheets("Tabelle1") 'Tabellenblatt mit dem Formular - Anpassen!
Set objWb = Workbooks.Open(strFile)
Set objSh = objWb.Sheets("Tabelle1") 'Tabelle in die geschrieben wird - Anpassen!

Zeile = Application.Max(objSh.Cells(Rows.Count, 1).End(xlUp).Row + 1, 3)

'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
    .Unprotect
    If .[b3] <> "" And .[d3] <> "" Then
        
        'Daten eintragen
        objSh.Cells(Zeile, 1) = .[b3]
        objSh.Cells(Zeile, 2) = .[d3]
        objSh.Cells(Zeile, 3) = .[b5]
        objSh.Cells(Zeile, 4) = .[d5]
        objSh.Cells(Zeile, 5) = .[b7]
        objSh.Cells(Zeile, 6) = .[d7]
        objSh.Cells(Zeile, 7) = .[b9]
        objSh.Cells(Zeile, 8) = .[d9]
        objSh.Cells(Zeile, 9) = .[b11]
        objSh.Cells(Zeile, 10) = .[d11]
        objSh.Cells(Zeile, 11) = .[b13]
        objSh.Cells(Zeile, 12) = .[d13]
        'Eingaben löschen
        .[b3:b13] = ""
        .[d3:d13] = ""
        .Protect
    Else
        MsgBox "Bitte Namen eintragen"
    End If
End With

objWb.Close True

ErrExit:

If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Set objWb = Nothing
Set objSh = Nothing
Set objThisSheet = Nothing
End Sub




Gruß Sepp





  

Betrifft: letzte Eintagung von: Maiks
Geschrieben am: 08.06.2008 19:28:12

Hallo Sepp,
ich habe noch eine Frage öffnet.
wäre es möglich, dass die letzte Eintragung immer oben bleibt bzw. immer in der Zeile 3?

danke für deine Mühe
Maik


  

Betrifft: AW: letzte Eintagung von: Josef Ehrensberger
Geschrieben am: 08.06.2008 19:38:25

Hallo Maik,

kein Problem.

Sub Daten_eintragen()
Dim objWb As Workbook, objSh As Worksheet, objThisSheet As Worksheet
Dim strFile As String

On Error GoTo ErrExit

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

strFile = "C:\Artikelliste\Preisliste.xls" 'Datei in die geschrieben wird - Anpassen!

Set objThisSheet = ThisWorkbook.Sheets("Tabelle1") 'Tabellenblatt mit dem Formular - Anpassen!
Set objWb = Workbooks.Open(strFile)
Set objSh = objWb.Sheets("Tabelle1") 'Tabelle in die geschrieben wird - Anpassen!


'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
    If .[b3] <> "" And .[d3] <> "" Then
        objSh.Rows(3).Insert
        .Unprotect
        'Daten eintragen
        objSh.Cells(3, 1) = .[b3]
        objSh.Cells(3, 2) = .[d3]
        objSh.Cells(3, 3) = .[b5]
        objSh.Cells(3, 4) = .[d5]
        objSh.Cells(3, 5) = .[b7]
        objSh.Cells(3, 6) = .[d7]
        objSh.Cells(3, 7) = .[b9]
        objSh.Cells(3, 8) = .[d9]
        objSh.Cells(3, 9) = .[b11]
        objSh.Cells(3, 10) = .[d11]
        objSh.Cells(3, 11) = .[b13]
        objSh.Cells(3, 12) = .[d13]
        'Eingaben löschen
        .[b3:b13] = ""
        .[d3:d13] = ""
        .Protect
    Else
        MsgBox "Bitte Namen eintragen"
    End If
End With

objWb.Close True

ErrExit:

If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Set objWb = Nothing
Set objSh = Nothing
Set objThisSheet = Nothing
End Sub




Gruß Sepp





  

Betrifft: AW: letzte Eintragung von: Maiks
Geschrieben am: 08.06.2008 19:58:34

Hallo Sepp,

es funktioniert! danke dir!

noch zwei kleinkeiten:
1- ich habe grade bemerkt, dass:
wenn die Datei Preisliste.xls schon geöffnet ist, der Makro macht die Datei zu nach der Eintragung.
ich finde sehr schön, dass der Makro nicht die Datei öffnen müss bevor er die Daten einträgt. (es ist gut, gefällt mir)
aber wenn, die Datei schön öffnet ist, kann er nicht die Einträgung machen trotz die Datei öffnet bleibt?

es wäre sehr sehr schön wenn du das hinkrigen kannst!

2- meine zweite Frage ist eine allgemeine Frage, da ich noch ein A bei Makro programmierung bin.

irgendwo in dem Makro steht das hier:

'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
If .[b3] <> "" And .[d3] <> "" Then


weil er prüft nur 2 Zelle!
wenn ich mehre als zwei Zelle prüfen müss, kann ich so umschreiben?

'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
If .[b3] <> "" ; .[b4];.[b5] and .[d3] <> "" Then

danke für deine Rückmeldung
Maik



  

Betrifft: AW: letzte Eintragung von: Josef Ehrensberger
Geschrieben am: 08.06.2008 21:39:14

Hallo Maik,

das geht auch. Zellen die du auf einen Eintrag prüfen willst, musst du einzeln angeben.

Sub Daten_eintragen()
Dim objWb As Workbook, objSh As Worksheet, objThisSheet As Worksheet
Dim strFile As String
Dim IsOpen As Boolean

On Error GoTo ErrExit

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

strFile = "C:\Artikelliste\Preisliste.xls" 'Datei in die geschrieben wird - Anpassen!

Set objThisSheet = ThisWorkbook.Sheets("Tabelle1") 'Tabellenblatt mit dem Formular - Anpassen!

For Each objWb In Application.Workbooks
    If objWb.FullName = strFile Then
        IsOpen = True
        Exit For
    End If
Next

If Not IsOpen Then Set objWb = Workbooks.Open(strFile)

Set objSh = objWb.Sheets("Tabelle1") 'Tabelle in die geschrieben wird - Anpassen!

'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
    If .[b3] <> "" And .[b4] <> "" And .[b5] <> "" And .[d3] <> "" Then
        objSh.Rows(3).Insert
        .Unprotect
        'Daten eintragen
        objSh.Cells(3, 1) = .[b3]
        objSh.Cells(3, 2) = .[d3]
        objSh.Cells(3, 3) = .[b5]
        objSh.Cells(3, 4) = .[d5]
        objSh.Cells(3, 5) = .[b7]
        objSh.Cells(3, 6) = .[d7]
        objSh.Cells(3, 7) = .[b9]
        objSh.Cells(3, 8) = .[d9]
        objSh.Cells(3, 9) = .[b11]
        objSh.Cells(3, 10) = .[d11]
        objSh.Cells(3, 11) = .[b13]
        objSh.Cells(3, 12) = .[d13]
        'Eingaben löschen
        .[b3:b13] = ""
        .[d3:d13] = ""
        .Protect
    Else
        MsgBox "Bitte Namen eintragen"
    End If
End With

If Not IsOpen Then objWb.Close True

ErrExit:

If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Set objWb = Nothing
Set objSh = Nothing
Set objThisSheet = Nothing
End Sub




Gruß Sepp





  

Betrifft: AW: letzte Eintragung von: Maiks
Geschrieben am: 08.06.2008 22:00:52

Hallo Sepp,

danke dir vielmals

funktioniert 100 pro

viele Grüße
Maik


  

Betrifft: AW: Dateneingabe ohne Userform von: Daniel
Geschrieben am: 08.06.2008 19:06:49

Hi

erstenmal wäre es hilfreich, wenn du schreiben würdest in welcher Programmzeile der Fehler auftritt.

wenn der von dir beschriebene Fehler auftritt (Index außerhalb des gülitgen bereichs), dann musst du prüfen, ob die Schreibweisen der Datei- oder Tabellenblattnamen im Makro korrekt sind.
falls nicht, müssen diese angepasst werden.

Außderdem,die Datei "Preisliste.xls" muss bei meinem Makro schon geöffnet sein, daß Öffnen dieser Datei habe ich nicht ins Makro eingebaut.

Gruß, Daniel


  

Betrifft: AW: Dateneingabe ohne Userform von: Maiks
Geschrieben am: 08.06.2008 19:18:02

vielen vielen dank an euch beide!!!
Sepp, dankschön, es funktiniert einwandfrei! danke sehr
Daniel, werde ich mich mit deinem Code auch weiterhin beschäftigt
Maik


 

Beiträge aus den Excel-Beispielen zum Thema "Dateneingabe ohne Userform"