VBS - MsgBox Abfrage

Hallo liebes administrator.de Forum,

hier eine kleine Struktur meines Vorhabens.
Wenn Excel geöffnet dann --> MsgBox (Ja/Nein) --> wenn Antwort "Ja" dann --> schreibe in aktive Arbeitsmappe und setze Offsets (ActiveCell) --> sonst --> erstelle eine neue Arbeitsmappe.
Desweiteren soll der StyleName überprüft werden. Falls der StyleName schon vorhanden ist, soll eine Sub (z.B. Style definieren) ignoriert werden.
Gibts da vllt. eine Find.Style Funktion?

Der Code sieht zur Zeit so aus.

	Set xExcel = GetObject(, "Excel.Application")  
	Answer = MsgBox("Wollen Sie in die aktive Arbeitsmappe schreiben?", 4)  
		If Answer = vbYes Then
			xExcel.ActiveCell.Offset(1, 1).Activate
		Else
			xExcel.Workbooks.Add
		End If
	Set ActiveWorkbook = xExcel.ActiveSheet

Das mit dem Offset muss noch bisschen überarbeitet werden.

Gruß,
unkwownuser

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 128294

Url: https://administrator.de/contentid/128294

Ausgedruckt am: 23.11.2024 um 01:11 Uhr

7 Kommentare

Neuester Kommentar

Hallo unknownuser!

Die Styleabfrage in etwa so:

Set xExcel = GetObject(, "Excel.Application")  

If TestStyle(xExcel.ActiveWorkbook, "Normal") = True Then MsgBox "True" Else MsgBox "False"  

Function TestStyle (ByRef Wkb, ByRef StyleName)
    Dim Style
    TestStyle = False
    For Each Style In Wkb.Styles
        If Style.Name = StyleName Then TestStyle = True:  Exit For
    Next
End Function

Gruß Dieter

Hallo Dieter,

erstmal vielen Dank für Hilfe.
Aber ich blicke nicht so wirklich durch, was du da gemacht hast. Könntest du das vllt. kurz erklären?

Gruß,
unkwownuser

Hallo unkwownuser!

Du willst ja wissen, ob ein bestimmter Style-Name schon existiert. Folglich muss ja die Style-Liste der aktiven Arbeitsmappe nach einem Style-Namen durchsucht werden.Die Liste enthält ja schon definierte Styles z.B. "Normal", "Percent", "Comma" usw. Und so eine Liste läßt sich mit einer For Each-Funktion auslesen, wobei Style immer ein Item von x-Items darstellt, also nachaneinander einen bestimmten Eintrag in einem Array suchen und wenn gefunden, dann Funktionsrückgabewert = True setzen und die Schleife verlassen. Der Funktionsrückgabewert muss natürlich vorher mit False initialisiert werden, sonst wäre der Rückgabewert = "", wenn der Style-Name nicht gefunden wurde. Beantwortet das Deine Frage?

Gruß Dieter

Hallo Dieter,

so grob habe ich es verstanden.
Jedoch besteht immer noch das gleiche Problem wie vorher.

Hier mal der aktuelle Code. Einfach zweimal öffnen (beim zweiten mal in die aktive Arbeitsmappe).

Set Shell = WScript.CreateObject("WScript.Shell")  
Result = Shell.AppActivate("Microsoft Excel")  

If Result = True Then
	Set xExcel = GetObject(, "Excel.Application")  
	Answer = MsgBox("In aktive Arbeitsmappe schreiben?", 4)  
		If Answer = vbYes Then
			If TestStyle(xExcel.ActiveWorkbook, "Style1") = True Then MsgBox "True" Else MsgBox "False"  
			Function TestStyle (ByRef Wkb, ByRef StyleName)
				TestStyle = False
				For Each Style In Wkb.Styles
					If Style.Name = StyleName Then TestStyle = True:  Exit For
				Next
			End Function
		Else
			xExcel.Workbooks.Add
		End If
	Set ActiveWorkbook = xExcel.ActiveSheet
Else
	Set xExcel = CreateObject("Excel.Application")  
	xExcel.Workbooks.Add
	xExcel.Visible = True
	Set ActiveWorkbook = xExcel.ActiveSheet
End If

Sub defineStyle(ByRef StyleName, ByRef FontName)
	With xExcel.ActiveWorkbook.Styles.Add(StyleName)
		.Font.Name = FontName
	End With
End Sub

Call defineStyle("Style1", "Tahoma")  

Gruß,
unkwownuser

Hallo unknownuser!

ungetestet eher so:

'Main Begin  

Set Shell = WScript.CreateObject("WScript.Shell")  
Result = Shell.AppActivate("Microsoft Excel")  

If Result = True Then
	Set xExcel = GetObject(, "Excel.Application")  
	Answer = MsgBox("In aktive Arbeitsmappe schreiben?", 4)  
		If Answer = vbYes Then
			If TestStyle(xExcel.ActiveWorkbook, "Style1") = False Then Call defineStyle("Style1", "Tahoma")  
		Else
			xExcel.Workbooks.Add
	  		Call defineStyle("Style1", "Tahoma")  
		End If
	Set ActiveWorkbook = xExcel.ActiveSheet
Else
	Set xExcel = CreateObject("Excel.Application")  
	xExcel.Workbooks.Add
	xExcel.Visible = True
	Set ActiveWorkbook = xExcel.ActiveSheet
	Call defineStyle("Style1", "Tahoma")  
End If

'.........  

'Main Ende  

Sub defineStyle(ByRef StyleName, ByRef FontName)
	With xExcel.ActiveWorkbook.Styles.Add(StyleName)
		.Font.Name = FontName
	End With
End Sub

Function TestStyle (ByRef Wkb, ByRef StyleName)
	TestStyle = False
	For Each Style In Wkb.Styles
	    If Style.Name = StyleName Then TestStyle = True:  Exit For
	Next
End Function

Grundsätzliches:
Sub's und Funktionen immer als solche seperat nach dem Main-Code plazieren. Wenn das Script gestartet wird, dann wird NUR der Code im Main-Teil ausgeführt.
Die Sub's und Funktionen werden nur ausgeführt, wenn sie aus dem Main-Teil oder aus einer anderen Sub/Funktion heraus aufgerufen werden.
Der Unterschied zwischen einer Sub und Funktion ist der, das bei Funtionen ein Wert zurückgegeben wird (Funktions-Name = Wert)

Gruß Dieter