Office: Prüfen ob Zelle in bestimmter Spalte markiert ist

kryox · 5. Januar 2016

Hallo zusammen,

ich würde gerne bevor die InputBox aufgeht und nach dem FA fragt prüfen, ob eine Zelle in der Spalte "H" ausgewählt ist und diese quasi vorziehen.

Als Beispiel:
Ich markiere die Zelle H20 und starte mein makro "zusatzinfo_erstellen".
Nun soll via Msgbox nachgefragt werden, ob ich für den den FA *** (Inhalt aus Spalte H20) eine Zusatzdatei erstellen möchte. Ja = Do It.. Nein = Nachfrage für welchen FA... (so wie bisher)
Ist eine andere Zelle (keine aus der Spalte H) markiert, soll er direkt fragen für welchen FA... (so wie bisher)

Ist das möglich?

Code:

Sub zusatzinfo_erstellen()
Dim zinfo As String
Anfang:
zinfo = InputBox("Für welchen FA soll eine Zusatzinfo angelegt werden?" & vbCrLf & "" & vbCrLf & "" & vbCrLf & "" & vbCrLf & "", "FA-Nr?:")
If zinfo = "" Then Exit Sub
If IsNumeric(zinfo) Then
Workbooks.Open Filename:= _
"\\FILE\Dokumente\_infos\_Zusatzinfo.xlsm"
Windows("_Zusatzinfo.xlsm").Activate
Range("A1").Select
ActiveCell.FormulaR1C1 = "ZUSATZINFOS ZU FA " & zinfo

ChDir "\\FILE\Dokumente\_infos"
ActiveWorkbook.SaveAs Filename:= _
"\\FILE\Dokumente\_infos\" & zinfo & ".xlsm", _
FileFormat:=52, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Else
MsgBox "Es dürfen nur Zahlen eingegeben werden!", vbCritical, "Nur Zahlen eingeben!"
GoTo Anfang
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Danke & grüße

:)

EarlFred · 7. Januar 2016

Hallo,

so?
Code:

Option Explicit

Sub zusatzinfo_erstellen()
Dim zinfo As String

'--------------------------
'zinfo festlegen / abfragen
Do

If ActiveCell.Column = 8 Then
If MsgBox("FA " & ActiveCell.Value & " wählen?", vbYesNo) = vbYes Then zinfo = ActiveCell.Value
End If
If zinfo = "" Then
zinfo = InputBox("Für welchen FA soll eine Zusatzinfo angelegt werden?" & vbCrLf & "" & vbCrLf & "" & vbCrLf & "" & vbCrLf & "", "FA-Nr?:")
End If

If zinfo = "" Then Exit Sub
If Not IsNumeric(zinfo) Then MsgBox "Es dürfen nur Zahlen eingegeben werden!", vbCritical, "Nur Zahlen eingeben!"

Loop Until IsNumeric(zinfo)

'--------------------------
'Datei bearbeiten
With Workbooks.Open(Filename:="\\FILE\Dokumente\_infos\_Zusatzinfo.xlsm")
.ActiveSheet.Range("A1").Value = "ZUSATZINFOS ZU FA " & zinfo
.SaveAs Filename:="\\FILE\Dokumente\_infos\" & zinfo & ".xlsm", _
FileFormat:=52, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüße
EarlFred

kryox · 7. Januar 2016

genau so!

vielen dank *Smilie

kryox · 23. März 2016

Hallo,

ich habe den Code noch etwas erweitert, und die neue Datei dann mit ein paar Infos zu füllen..

Code:

Option Explicit

Sub zusatzinfo_erstellen()
Dim zinfo As String

Do
If ActiveCell.Column = 8 Then
If MsgBox("Zusatzinfo für FA " & ActiveCell.Value & " angelegen?", vbYesNo + vbQuestion, "Zusatzinfo anlegen") = vbYes Then zinfo = ActiveCell.Value
End If
If zinfo = "" Then
MsgBox "Bitte die FA-Nummer in der jeweiligen Zeile markieren und erneut versuchen!", vbInformation, "Fehler!"
End If

If zinfo = "" Then Exit Sub
If Not IsNumeric(zinfo) Then MsgBox "Es dürfen nur Zahlen eingegeben werden!", vbCritical, "Nur Zahlen eingeben!"

Loop Until IsNumeric(zinfo)

'--------------------------
'Datei bearbeiten

Dim x
Dim i

x = Cells(Rows.Count, 8).End(xlUp).Row

For i = 1 To x
Dim fa As Variant
Dim modell As Variant
Dim modellnr As Variant
Dim artikel As Variant
Dim farbe As Variant
Dim prod As Variant
Dim gesp As Variant
Dim zoll As Variant
Dim we As Variant

If Cells(i, 8) = zinfo Then
fa = Cells(i, 8)
modell = Cells(i, 10)
modellnr = Cells(i, 9)
artikel = Cells(i, 11)
farbe = Cells(i, 12)
prod = Cells(i, 4)

End If
Next

Dim dname
dname = zinfo & "-" & modell & "-" & artikel & "-" & farbe

With Workbooks.Open(filename:="\\FILE\Dokumente\_infos\_Zusatzinfo.xlsm")
.ActiveSheet.Range("A1").Value = "ZUSATZINFOS ZU FA " & zinfo
.ActiveSheet.Range("B3").Value = modell & " (" & modellnr & ")"
.ActiveSheet.Range("B4").Value = artikel
.ActiveSheet.Range("B5").Value = farbe
.ActiveSheet.Range("B6").Value = prod

.SaveAs filename:="\\FILE\Dokumente\_infos\" & dname & ".xlsm", _
FileFormat:=52, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Leider funktioniert das ganze nicht, wenn ich 2 Zeilen mit der selben FA-Nr. in der Spalte H (8) habe..

Beispiel:
Spalte 8 9 10 11 12
59828 40295 JAZ 109015 3
59828 40295 JAZ 109015 37

Wenn ich die Spalte 8 markiere und auf meinen Button klicke, holt er sich immer die Farbe 37 beim Speichern..

Gibt es eine Möglichkeit meinen Code umzuschreiben, dass er sich die Infos aus der Zeile holt, die beim Buttonklick markiert wurde???

Vielen Dank & grüße

Office: Prüfen ob Zelle in bestimmter Spalte markiert ist

Prüfen ob Zelle in bestimmter Spalte markiert ist

Prüfen ob Zelle in bestimmter Spalte markiert ist

Prüfen ob Zelle in bestimmter Spalte markiert ist

Prüfen ob Zelle in bestimmter Spalte markiert ist - Similar Threads - Prüfen Zelle bestimmter

Zelle per VBA auf ihren Inhalt prüfen und reagieren sowie bei Änderung

Prüfung unterschiedlicher Zellen auf Inhalt und Konsequenz

zwei Zellen prüfen steht was drinnen dann schreib text

Wert aus Zelle in einer anderen Datei suchen und prüfen, ob weiterer Wert vorhanden ist

Prüfen und Verketten von Zellen mit Formeln als Inhalt

Verwenden von WENN, um zu prüfen, ob eine Zelle leer ist

Prüfen, ob eine Zelle in einer Spalte einen bestimmten Wert hat ...