Excel, Variable in Msg Box integrieren?

Hallo, wie kann ich eine Variable in einer Msg Box integrieren.

Folgendermaßen sieht der Code aus:

'Sollte eins der Felder (Monat.Text, Referenz.Text, Wert.Text) unausgefüllt sein, so soll die Variable den folgenden Wert annehmen

Dim Fehlendes_Feld As String

If Monat.Text = "" Then Fehlendes_Feld = Monat

If Referenz.Text = "" Then Fehlendes_Feld = Referenz

If Wert.Text = "" Then Fehlendes_Feld = Wert

MsgBox Prompt:="Bitte folgendes Feld ausfüllen: Fehlendes_Feld ", Title:="Fehler"

Die Msg Box zeigt mir halt den Text an und passt die Variable leider nicht an. Wie ändere ich das?

2 Antworten

Xandros0506

10.11.2022, 11:34

Die Msg Box zeigt mir halt den Text an

Genau das hast du ja auch mit der Zeile so festgelegt

:="Bitte folgendes Feld ausfüllen: Fehlendes_Feld"

Innerhalb der Anführungszeichen ist das Text. Selbst wenn es eine Variable gibt, die diese Bezeichnung hat. Soll die Variable verwendet werden, muss das entsprechend an den Text angehängt werden.

:="Bitte folgendes Feld ausfüllen: " & Fehlendes_Feld, Title:

TygaX

Beitragsersteller

10.11.2022, 11:38

Habs auch schon versucht, zuerst funktionierte es nicht aber jetzt. Vllt irgendwo ein Zeichenfehler. Danke dir!

daCypher

10.11.2022, 12:07

Du musst natürlich die Werte, die in die Variable Fehlendes_Feld geschrieben werden sollen, in Anführungszeichen setzen, sonst denkt VBA, dass du einfach den Inhalt einer bisher unbekannten Variable zuweisen willst (was dann einfach ein leerer String ist). Um den Stolperstein zu entfernen, schreibe am besten in jedes VBA Modul als erste Zeile den Befehl "Option Explicit" rein. Dann sagt dir VBA, wenn es eine Variable nicht kennt (hilft z.B. auch bei Schreibfehlern in Variablennamen)

Und damit du in die MsgBox nicht den Text "Fehlendes_Feld", sondern tatsächlich das fehlende Feld drinstehen hast, musst du den String dementsprechend verketten:

'Sollte eins der Felder (Monat.Text, Referenz.Text, Wert.Text) unausgefüllt sein, so soll die Variable den folgenden Wert annehmen

Dim Fehlendes_Feld As String

If Monat.Text = "" Then Fehlendes_Feld = "Monat"

If Referenz.Text = "" Then Fehlendes_Feld = "Referenz"

If Wert.Text = "" Then Fehlendes_Feld = "Wert"

MsgBox Prompt:="Bitte folgendes Feld ausfüllen: " & Fehlendes_Feld, Title:="Fehler"

Ähnliche Beiträge

Mehrere MsgBox-Abfragen hintereinander möglich?

Hallo, da hier doch so viele Könner unterwegs sind: Ich hänge schon wieder fest.

Ich habe zwei msg-Boxen vbYesNoCancel. Wenn die erste Box mit Ja bestätigt wird, wird eine Prozedur gestartet.
Wenn ich den Button Abbrechen klicke, soll die zuletzt geöffnete Userform neu geladen und die Sub beendet werden.

Wenn ich den Nein Button klicke öffnet sich die nächste msg Box vbYesNoCancel.
Wenn nun Ja geklickt wird, wird wieder eine Prozedur gestartet, beim Abbrechen wieder die Userform neu geladen und die Sub beendet.
Und bei Nein wird eine weitere Prozedur gestartet.

Eigentlich dürfte es ja nicht schwer sein, aber bei mir hängt es. Die Userform wird neu geladen aber die nächste msg Box öffnet nur und dann passiert nichts, wenn ich dort einen Button klicke.

So sieht es nun aus (und vielen Dank im Voraus):

Public Sub InspectionCriterion()
    Dim msg As String, msg2 As String, msg3 As String
    msg = MsgBox("Ist das Merkmal ein Gewinde?", vbYesNoCancel + vbQuestion, "")
    


    If msg = vbYes Then
    UserFormThread.Show
    ElseIf msg = vbNo Then
    msg2 = MsgBox("Ist das Merkmal zu messen?", vbYesNoCancel + vbQuestion, "")
    ElseIf msg = vbCancel Then
    Call InspectionFeatures
    Exit Sub
    


    If msg2 = vbYes Then
    UserFormDimension.Show
    ElseIf msg2 = vbNo Then UserFormText.Show
    Else
    Exit Sub
    End If
    End If
    
    
End Su

...zum Beitrag

Excel, Optionsfelder einbauen?

Hallo, sobald ich auf die Schaltfläche "Hinzufügen" klicke, möchte ich gerne das überprüft wird, ob alle Felder ausgefüllt sind und eine der Optionen angewählt ist.

Alles klappt bisher nur die Überprüfung der Optionsfelder nicht.

Mein Ansatz war:

'Prüfung_2: Wahl zwischen Einnahme oder Ausgabe

If EinnahmenOption.Value = "False" Or AusgabenOption.Value = "False" Then

MsgBox Prompt:="Wähle Einnahme oder Ausgabe.", Title:="Option wählen"

Else

Prüfung_2 = "True"

End If

Problem ist, dass selbst wenn ich nichts auswähle keine Meldung kommt und einfach immer Prüfung_2 auf true gesetzt wird.

...zum Beitrag

VBA MSG BOX Titel nur aufzählen wenn Spalte "L" bestimmter Text?

Hallo zusammen,

ich komme bei diesem Code nicht weiter. Die Msgbox soll nur die Zeilen auflisten wenn ihn Spalte "L" der Text "offen" vorkommt. Kann mir dabei jemand bitte behilflich sein?

Private Sub Workbook_Open()

Dim rDatWartung

Dim sMsgBaldFaellig As String

Dim sMsgUeberFaellig As String

sMsgBaldFaellig = ""

sMsgUeberFaellig = ""

lz = Cells(Rows.Count, 5).End(xlUp).Row

For Each rDatWartung In Range("D30:D600")

If rDatWartung.Value <> "" Then

If rDatWartung.Value <= Date + 7 Then

sMsgUeberFaellig = sMsgUeberFaellig & Cells(rDatWartung.Row, 4) & " " & vbCrLf & Cells(rDatWartung.Row, 6)

Else

If rDatWartung.Value <= Date + 14 Then _

sMsgBaldFaellig = sMsgBaldFaellig & Cells(rDatWartung.Row, 4) & " " & Cells(rDatWartung.Row, 4) & vbCrLf

End If

If sMsgUeberFaellig & sMsgBaldFaellig <> "" Then

MsgBox "Überfällig" & vbCrLf & " " & sMsgUeberFaellig

End If

End Sub

Herzlichen Dank, und einen schönen Abend

...zum Beitrag

VBA zu HTML Code umgewandelt - Zeilenumbrüche weg?

Hallo,

ich habe durch den unten beigefügten Code versucht eine E-Mail samt Signatur automatisch kommen zu lassen. Nun habe ich das Problem, dass die Absätze in der Mail weg sind und alles in einer Zeile ist. Wie behebe ich das?

Private Sub CommandButton2_Click()

Dim objOutlook As Object

Dim objMail As Object

Dim S As String

Dim body As String

Dim htbody As String

Set objOutlook = CreateObject("Outlook.Application")

Set objMail = objOutlook.CreateItem(0)

If TextBox2.text = "" Or TextBox2.text = TextBox1.text Then

body = "Sehr geehrte Frau x," & vbCrLf & _

vbCrLf & _

"Folgende/r Mitarbeiter/in ist erkrankt:" & vbCrLf & _

vbCrLf & _

ComboBox1.text & vbCrLf & _

vbCrLf & _

"Zeitraum: " + TextBox1.text

Else

body = "Sehr geehrte Frau x," & vbCrLf & _

vbCrLf & _

"Folgender Mitarbeiter ist erkrankt:" & vbCrLf & _

vbCrLf & _

ComboBox1.text & vbCrLf & _

vbCrLf & _

"Zeitraum: " + TextBox1.text + " bis " + TextBox2.text

End If

htbody = fnConvert2HTML(htbody)

S = Environ("appdata") & "\Microsoft\Signatures\autoE-Mailsenden.htm"

If Dir(S, vbDirectory) <> vbNullString Then

S = S

S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1, -2).readall

With objMail

.To = "x.de"

.Subject = "Krankmeldung " + ComboBox1.text + " x"

htbody = body & " " & S

.htmlbody = "" & htbody & ""

.Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!

End With

Else

' With objMail

' .To = Empfänger

' .Subject = Betreff

' htbody = body '& " " & S

' .htmlbody = "" & htbody & ""

' .Display

' ' .Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!

' End With

End If

End Sub

Zudem noch folgende Funktion:

Function fnConvert2HTML(myText As String) As String

Dim bldTagOn, itlTagOn, ulnTagOn, colTagOn As Boolean

Dim i, chrCount, n As Integer

Dim chrCol, chrLastCol, htmlTxt As String

Dim myChar As String

bldTagOn = False

itlTagOn = False

ulnTagOn = False

colTagOn = False

chrCol = "NONE"

htmlTxt = "<html>"

chrCount = Len(myText)

End Function

Danke im voraus!!!

...zum Beitrag

Maximale Pfadlänge in Windows und VBA umgehen?

Hallo,

ich benutze folgenden Code in Excel VBA um mir Dateipfad und Dateiname eines Ordners und allen darin enthaltenen Unterordnern aufzulisten.
(Ihr könnt es testen, den Code einfach in ein Modul kopieren, "MainList" ausführen und einen Ordner eurer Wahl auswählen)

Ich habe jetzt das Problem, dass dieser Code alle Dateien überspringt, deren Pfadlänge über 255 Zeichen lang ist. Einige Dateien überschreiten nämlich die 255 Zeichen mit dem angehängten Dateinamen.
Sie liegen aber dennoch ab. Nur liest VBA diese nicht aus. Kann man da was dran machen?

Sub MainList()
'Updateby Extendoffice
Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
If Folder.Show <> -1 Then Exit Sub
xDir = Folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
End Sub

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Path
  Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
  rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
  Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub

Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
  Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
  GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
  GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function

...zum Beitrag

IF Funktion in excel auf mehrere Zellen anwenden?

Hallo,

Ich möchte wenn in einer Zelle etwas reingeschrieben wird das die darauffolgenden Felder zu Pflichtfelder werden. Dazu nutze ich aktuell folgende Formel.

Private Sub Workbook_BeforePrint(Cancel As Boolean)

Dim zeile As Long, OK As Boolean

OK = True

For zeile = 1 To Tabelle1.Cells.SpecialCells(xlCellTypeLastCell).Row

If Worksheets("Tabelle1").Cells(4, 2).Value <> "" Then

If Worksheets("Tabelle1").Cells(4, 3).Value = "" Then OK = False 'Spalte C

If Worksheets("Tabelle1").Cells(4, 4).Value = "" Then OK = False 'Spalte D

If Worksheets("Tabelle1").Cells(4, 5).Value = "" Then OK = False 'Spalte E

If Worksheets("Tabelle1").Cells(4, 6).Value = "" Then OK = False 'Spalte F

If Worksheets("Tabelle1").Cells(4, 8).Value = "" Then OK = False 'Spalte H

If Worksheets("Tabelle1").Cells(4, 9).Value = "" Then OK = False 'Spalte I

End If

If Not OK Then

MsgBox "Drucken nicht möglich - nicht alle Pflichtfelder ausgefüllt"

Cancel = True

End If

End Sub

Nun möchte ich das die obige Formel von B4- B25 durchgeführt wird. Also das wenn in in B8 z.B. etwas reingeschrieben wird das dann die Zellen in B8 geprüft werden das dort in den anderen Feldern auch was reingeschrieben worden ist.
Wie würde ich das ganze hinbekommen?

Danke im Voraus

...zum Beitrag

[VBA] - Multipage Userform eingaben in Excel übertragen?

Servus Leute,

Ich habe ein Userform in Excel mit Multipage erstellt.

Nun möchte ich auf der letzten Multipage Seite einen Button einbauen. Auf Knopfdruck sollen dann alle Eingaben die vom User auf den einzelnen Multipageseiten gemacht worden sind in ein Excel Tabellenblatt übertragen werden.

Mein Ansatz war dem Button folgenden Code zu geben:

    Dim sheet2 As Worksheet
    Dim maxRow2 As Long
    Dim check3 As Boolean
    Set sheet2 = ActiveWorkbook.Worksheets(1)
    maxRow2 = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row
    If CheckBox1.Value Then
      sheet2.Cells(maxRow2 + 1, 9).Value = "ja"
      Else
        sheet2.Cells(maxRow2 + 1, 9).Value = "nein"
        End If
              sheet2.Cells(maxRow2 + 1, 13).Value = TextBox4.Value

Das funktioniert leider nicht wie ich es mir erhofft habe, auf Knopfdruck werden keine Daten übertragen. Ich habe die vermutung, dass nicht auf die Felder wie z.B. TextBox4 zugegriffen werden kann, weil die auf einer anderen Seite im Multipage sind.

Wie schaffe ich es an die Variablen ranzukommen. Ich hatte noch überlegt, im Code der jeweiligen Seite den Wert aus der Textbox in eine Variable zu setzen, die z.B. Global ist. Aber da bin ich auch schon wieder überfragt wie man das macht.

Außerdem habe ich noch eine Frage zu den Checkboxen.

Es soll folgende Möglichkeiten geben:

Wenn Checkbox nicht angeklickt, dann kann man immer zu nächsten Kategorie ( Nächste Seite im Multipage)
Wenn Checkbox angeklickt ist und variable x leer, dann soll man nicht weiter kommen (Msgbox)
Wenn Checkbox angeklickt ist und variable x befüllt, dann kann man zur nächsten Kategorie (Nächste Seite im Multipage)

Für eine Checkbox habe ich das schon hinbekommen, aber wie mach ich das wenn es mehrere Checkboxen gibt. Weil ich glaube wenn ich das so mache wie bisher, dann wird das eine endlose anreihung von if bedingungen.

Diesen Code habe ich dann auf den Button gelegt, mit dem man zur nächsten Kategorie kommen soll oder eben halt nicht.

  Dim sheet2 As Worksheet
    Dim maxRow2 As Long
    Dim check3 As Boolean
    Set sheet2 = ActiveWorkbook.Worksheets(1)
    maxRow2 = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row
   
    If CheckBox3.Value Then
    If Test = False Then
    MsgBox ("Kein Pfad angegeben")
    Else
  Dim iNextPage As Long
    With Me.MultiPage1
        iNextPage = .Value + 1
        If iNextPage < .Pages.Count Then
            .Pages(iNextPage).Visible = True
            .Value = iNextPage
        End If
    End With
    End If
    Else
    Dim iNextPage2 As Long
    With Me.MultiPage1
        iNextPage2 = .Value + 1
        If iNextPage2 < .Pages.Count Then
            .Pages(iNextPage2).Visible = True
            .Value = iNextPage2
        End If
    End With
    End If

Und als letztes würde ich gern noch wissen ob es möglich ist, zu unterbinden, dass der User oben im Multipage die Kategorie direkt anklicken kann und man halt nur über den "weiter" button zur nächsten kategorie kommt.

Gruß Chris

...zum Beitrag

Excel-Code für Mehrfachauswahl in Dropdown-Listen?

Hallo zusammen,

Ich versuche gerade ein Excel-Dokument zu erstellen, bei dem eine Mehrfachauswahl aus Dropdown-Listen möglich ist. Das heißt aus einer Liste sollte es möglich sein mehrere Werte anzuwählen. Das habe ich auch mit dem untenstehenden VisualBasic-Code gemeistert. Allerdings habe ich erstens das Problem, dass auch eine Mehrfachauswahl des immer gleichen Wertes möglich ist. Theoretisch könnte also in einer Zelle x-mal derselbe Werte auftauchen. Dies soll natürlich nicht möglich sein. Bei Doppelauswahl desselben Wertes soll dieser aus der Zelle wieder verschwinden.

Mein zweites Problem ist, dass ich bislang nur 2 zwei Dropdown-Listen mit Mehrfachauswahl eingefügt bekomme. Sobald ich eine dritte Spalte versuche zu implementieren, bekomme ich eine Fehlermeldung für meinen Code.

Dadurch, dass ich mich mit dem Ganzen nicht so wirklich auskenne, wäre es sehr nett, wenn mir jemand helfen könnte.

Danke!

Bisheriger Code:

Private Sub Worksheet_Change(ByVal Target As Range)

** Mehrfachauswahl über DropDown-Liste

'** Einfügen im Code-Container des betreffenden Arbeitsblattes

'** Dimensionierung der Variablen

Dim rngDV As Range

Dim wert_old As String

Dim wertnew As String

'** Errorhandling

On Error GoTo Errorhandling

'** Mehrfachauswahl im definierten Bereich "Abteilungen" und "Themen" (Bsp. J2:J2000, I2:I2000) durchführen

If Not Application.Intersect(Target, Range("J2:J2000", "I2:I2000")) Is Nothing Then

'**Range definieren

Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)

If rngDV Is Nothing Then GoTo Errorhandling

'** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen

If Not Application.Intersect(Target, rngDV) Is Nothing Then

Application.EnableEvents = False

wertnew = Target.Value

Application.Undo

wertold = Target.Value

Target.Value = wertnew

If wertold <> "" Then

If wertnew <> "" Then

Target.Value = wertold & ", " & wertnew

End If

Application.EnableEvents = True

End If

Errorhandling:

Application.EnableEvents = True

End Sub

...zum Beitrag

PDF Datei per Excel via Outlook senden?

Hallo Zusammen!

Ich habe folgenden Code zum erstellen einer PDF aus einem Sheet.

Der Code erstellt einen PDF namen und gibt dem Benuzter die Wahl zu speichern wo er will.. Danach kommt noch eine MSG Box und führt einen Datenbankbefehl aus usw.. Alles soweit ok..

Kann man zusätzlich die Datei noch in "Temp" speichern und per PDF senden? Als Betreff den Dateinamen ? Gerne würde ich auch den Emailempfänger direkt vorgeben und wenn möglich auch das senden ohne bestätigen ausführen.. geht das?

Sub speichern_unter_PDF_AV() a = MsgBox("WKZ ins Budget übertragen?", _ vbYesNo + vbQuestion, "WKZ buchen, PDF erstellen?") If a = vbYes Then 'Bereich kopieren Sheets("AV Markt").Range("AH14:AO14").Copy 'einfügen in erste freie Zeile in ausgabe Sheets("Datenbank AV").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'Kopiermodus beenden Application.CutCopyMode = False Name = Range("Z1") Sheets("AV Markt").Activate Dim neuerDateiname As String neuerDateiname = Application.GetSaveAsFilename("C:\Temp\" & "AV - " & Name & Format(Date, "dd.mm.yyyy") & ".pdf", "Adobe PDF-Dateien (.pdf),.pdf") If Not neuerDateiname = "Falsch" Then ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=neuerDateiname, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=True Dim loI Dim WsShell Set WsShell = CreateObject("WScript.Shell") loI = WsShell.Popup("WKZ erfolgreich übertragen!" & vbCrLf _ & " " & vbCrLf _ & "AV bitte übermitteln" & vbCrLf _ & " " & vbCrLf _ & "AV´s müssen unterschrieben auf dem Laufwerk abgelegt werden!" & vbCrLf _ & "Danke", Title:=" Power Team") End If End If End Sub

...zum Beitrag

Excel Colorsum Ergebnis automatisch aktualisieren lassen?

Moin, ich habe in Excel über Visual Basics folgenden Code eingefügt:

Function ColorSum(ByRef Source As Range, ByVal Color As Integer, Optional ByVal ForeOrBack As Boolean = -1) As Double

Dim rng As Range, dblSum As Double

Application.Volatile

If Color < 0 Or Color > 56 Then Color = IIf(ForeOrBack, -4142, -4105)

For Each rng In Source

If IsNumeric(rng) Then

If ForeOrBack Then

If rng.Interior.ColorIndex = Color Then dblSum = dblSum + rng

Else

If rng.Font.ColorIndex = Color Then dblSum = dblSum + rng

End If

ColorSum = dblSum

End Function

Dies hat die Funktion, dass ich zahlen zusammen rechnen kann anhand der Farbe. Das Funktioniert auch alles so weit. Nur weiß ich nicht wie ich es hinkriege dass sich das Ergebnis automatisch aktualisiert nachdem ich die Farbe z.B. von rot auf grün umändere. Dann sollte eigentlich aus summe X eine summe heraus kommen die um 1 weniger ist. Dies sehe ich aber erst dann, nachdem ich in die Spalte gehe (wo die Formel ist) und die Entertaste drücke. Geht das auch ohne das ich es Manuell aktualisieren muss?

...zum Beitrag

VBA Ausgewählte Zeilen kopieren und in anderer Tabelle einfügen (mit Variablen)?

Hallo Zusammen,

Ich hab ein Problem. Ich würde gern durch das schreiben einer 1 hinter meiner Materialsammlung per Knopfdruck alle gewählten Zeilen in eine Zusammengestellte Tabelle einfügen.

Die Materialsammlung bei der ich auswähle ist in Tabelle zwei und wird dann per Knopfdruck abgefragt. Die markierten sollen dann in Tabelle 1 in eine Tabelle eingefügt werden.

Da ich aber mit Variablen Arbeite ist das schwieriger als gedacht

Hier mein code zum verdeutlichen

Private Sub CommandButton1_Click()

Dim strBereich As Range Dim x As Integer

For x = 3 To 60 If Worksheets(2).Cells(x, 10) = "1" Then

Worksheets(1).Range(Cells(x, 2), Cells(x, 9))=Worksheets(2).Range(Cells(x, 1), Cells(x, 8))

End If Next x

End Sub

funktioniert leider aber nicht.

Bitte im Hilfe

...zum Beitrag

Excel VBA: Bild einfügen, in Variable speichern, Größe ändern, ausrichten?

Ich habe jetzt unzähle Varianten durch. Ich baue ein Bestellsystem für zwei verschieden Shops. Heißt, bei jedem eingetragenen Artikel in die Bestellliste soll am Ende der Listen-Zeile das jeweilige Logo eingefügt werden, kleiner als das Originalbild, kleiner als die Zeile selbst, für die Übersichtlichkeit in der Liste, mittig ausgerichtet.

Ich habe von Pictures.Insert zu Shapes.AddPicture gewechselt, da ich gelesen habe, dass dies die korrektere Form sei. Jetzt bekomme ich eine Fehlermeldung bei der Festlegung eines Rahmens.
Kann mir jemand meine Fehler aufzeigen? Folgende Fragen stellen sich mir:
- Welchen Variablen-Typ brauche ich für ein eingefügtes Bild?
- Wie kann ich diese Variable dann verwenden, um Größe, Position und Rahmen festzulegen?

Danke sehr!!!!!!

Sub LogoEinfügen(Shop As String, Zeile As Integer, Spalte As Integer)

Dim Breite As Integer
Dim Höhe As Integer
Dim strDatei As String
Dim Logo As Object
Dim ShopFarbe As Long, Rot As Long, Blau As Long

' Farben für die zwei Shops festlegen
Rot = 26316
Blau = 13395456

' Dateinamen je nach Shop auswählen und Shop-Farbe einstellen
If Shop = "ZL" Then
  strDatei = "D:\logo1.jpg"
  ShopFarbe = Rot
End If

If Shop = "AQ" Then
  strDatei = "D:\logo2.jpg"
  ShopFarbe = Blau
End If

' Bild einfügen

' Ort festlegen
Dim rg As Range
Set rg = ActiveSheet.Cells(Zeile, Spalte)

' Und einfügen
Set Logo = ActiveSheet.Shapes.AddPicture(strDatei, msoTrue, msoTrue, rg.Left, rg.Top, -1, -1)
Set rg = Nothing

With Logo
      .LockAspectRatio = msoFalse              ' Verzerrung egal
      .Height = Rows(Zeile).RowHeight - 4      ' kleiner als Zeile
      .Width = Columns(Spalte).Width - 4       ' schmaler als Spalte
      .Top = Cells(Zeile, Spalte).Top + (Cells(Zeile, Spalte).Height - Logo.Height) / 2         ' mittig
      .Left = Cells(Zeile, Spalte).Left + (Cells(Zeile, Spalte).Width - Logo.Width) / 2          ' mittig
  End With
  
  ' Rahmen ums Bild, in der Farbe des Shops
  With Logo.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.RGB = ShopFarbe
    .Weight = 1.5
    .ForeColor.TintAndShade = 0
  .ForeColor.Brightness = 0
End With

Set Logo = Nothing

' Zeilenhöhe anpassen
' Rows(Zeile).RowHeight = Logo.Height
 
End Sub

...zum Beitrag

VBA Message-Box mit zwei Bedingungen?

Hallo zusammen,

ich versuche eine Message-Box in Excel zu erzeugen, die beim Wechsel eines Worksheets bald fällige bzw. überfällige Termine anzeigt. Dabei stehen die Fälligkeiten in der Spalte K. Eine solche Meldung soll allerdings unterbleiben, sofern der Bearbeitungsstand auf "abgeschlossen" gesetzt wurde. Der Bearbeitungsstand wird in der Spalte N mittels Dropdown-Liste erfasst.

Mein Code sieht folgendermaßen aus:

Private Sub Worksheet_Activate()

Dim rDatTermin

Dim rDatStand

Dim sMsgBaldFaellig As String

Dim sMsgUeberFaellig As String

Dim sMsgAbgeschlossen As String

sMsgBaldFaellig = ""

sMsgUeberFaellig = ""

For Each rDatTermin In Range("K4:K500")

If rDatTermin.Value <> "" Then

If rDatTermin.Value < Date Then

sMsgUeberFaellig = sMsgUeberFaellig & Cells(rDatTermin.Row, 2) & vbCrLf

Else

If rDatTermin.Value <= Date + 14 Then _

sMsgBaldFaellig = sMsgBaldFaellig & Cells(rDatTermin.Row, 2) & vbCrLf

End If

For Each rDatStand In Range("N4:N500")

If rDatStand.Value <> "" Then

If rDatStand.Value = "abgeschlossen" Then _

sMsgAbgeschlossen = 1

End If

If sMsgUeberFaellig & sMsgBaldFaellig <> "" & sMsgAbgeschlossen <> 1 Then

MsgBox "Überfällig" & vbCrLf & vbCrLf & sMsgUeberFaellig & "Bald fällig" & vbCrLf & sMsgBaldFaellig

End If

End Sub

Offensichtlich klappt hier die Verknüpfung zur zweiten Bedingung noch nicht. Die erste Bedingung wird geprüft und korrekt angezeigt. Der Bearbeitungsstand wird dabei jedoch nicht berücksichtigt. Wo habe ich da meinen Gedankenfehler?

...zum Beitrag

VBA Programmierung - Automatischer Email versandt Probleme?

Hallo ich hoffe Ihr könnt mir helfen :/

Folgendes Problem: Wenn ich die Mail versende, öffnen sich für jede Zeile eine extra Email und leider auch nur jeweils ein Empfänger und einer in cc.

Was muss ich nun in der Programmierung hinzufügen, um nur eine Email geöffnet zu bekommen, mit mehreren Empfängern (Falls mehrere Kreuze gesetzt worden sind). Ich danke euch echt wenn Ihr mir helfen können :/

Ich habe mir die Bausteine aus dem Internet zusammengesetzt, bin daher kein Profi darin.

Programmtext:

Private Sub Send_Email()
   '-------------< Send_Email() >-------------
   Dim sTitle As String
   sTitle = "Test-HTML Email from Excel"
   '< HMTL holen >
   Dim sTemplate As String
   sTemplate = Sheets("ini_Vorlage").Shapes(1).TextFrame2.TextRange.Text
   '</ HMTL holen >
   '----< Send with Outlook >----
   Dim app_Outlook As Outlook.Application
   Set app_Outlook = New Outlook.Application
   '--< Email einstellen >--
   Dim objEmail As Outlook.MailItem
   Dim sEmail_Addresscc As String
   Dim sEmail_Address As String
   Dim iRow As Integer
   For iRow = 4 To 100
       If Cells(iRow, 21) = "x" Then
           '< get Email Address >
           'Column 2, B
           sEmail_Address = Cells(iRow, 19)
           sEmail_Addresscc = Cells(iRow, 20)
           '</ get Email Address >
           '< Fill Placeholders >
           Dim sHTML As String
           sHTML = Replace(sTemplate, "[@Name]", sEmail_Address)
           '</ Fill Placeholders >
           '--< Send Email >--
           Set objEmail = app_Outlook.CreateItem(olMailItem)
           objEmail.To = sEmail_Address
           objEmail.CC = sEmail_Addresscc
           objEmail.Subject = sTitle
           'objEmail.HTMLBody = sHTML 'use .HTMLBody for HTML
           objEmail.Body = sHTML      'and .body for pure Text
           objEmail.Display
           '--</ Send Email >--
       End If
   Next
   '< Abschluss >
   Set objEmail = Nothing
   Set app_Outlook = Nothing
   '</ Abschluss >
   MsgBox "Emails erstellt", vbInformation, "Fertig"
   '----</ Send with Outlook >----
   '-------------</ Send_Email() >-------------
End Sub

...zum Beitrag

Was möchtest Du wissen?

Deine Frage stellen