Excel Russisch Roulett?

Ich hab mich an Russische Roulett gewagt...
Und dabei folgendes asuprobiert

Bild zum Beitrag

Der Schieß Button ist mit folgendem Macro verknüpft:

Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)


Sub Drehung()
'
' Drehung Makro
'

'

Dim i As Integer
Dim z As Integer

Range("C100").Select
Selection.ClearContents

i = 0
z = Cells(1, 1)

'Schnelles Drehen
Do Until i = 100
i = i + 1


   ActiveSheet.ChartObjects("Diagramm 2").Activate
   ActiveChart.FullSeriesCollection(1).Select
   ActiveChart.ChartGroups(1).FirstSliceAngle = z
   Range("R22").Select

   If z < 355 Then
   z = z + 5

   Else
   z = 0

   End If
   Application.Calculate
   Sleep (6)
   DoEvents
   DoEvents

   Loop

'Langsames Drehen
Do Until i = 165
i = i + 1


   ActiveSheet.ChartObjects("Diagramm 2").Activate
   ActiveChart.FullSeriesCollection(1).Select
   ActiveChart.ChartGroups(1).FirstSliceAngle = z
   Range("R22").Select

   If z < 358 Then
   z = z + 2

   Else
   z = 0

   End If
   Application.Calculate
   Sleep (6)
   DoEvents
   DoEvents

   Loop


End Sub

Und nun zu meiner Frage ist es irgendwie möglich die Grad in den das Diagramm2 (also die "Trommel" | Kreis ) zeigt mit einer Formel anzuzeigen.

Ich brauch dies um zu wissen ob der Spieler dann stirbt oder nicht.
(Andere Vorschläge wie es zu ermöglichen ist , sind offen )

Danke für eure Hilfe im Vorraus!!

3 Antworten

Vom Beitragsersteller als hilfreich ausgezeichnet

safur

18.12.2020, 19:13

Mit Elevation evtl.

https://docs.microsoft.com/de-de/office/vba/api/excel.chart.elevation

Ich habe es nicht ausprobiert.

Vielleicht findest du hier noch etwas passendes:

http://codevba.com/de/Excel/Chart.htm#.X9zwvhYxmUk

TAEBoost

Beitragsersteller

18.12.2020, 19:41

https://docs.microsoft.com/de-de/office/vba/api/excel.chart.elevation

das wird glaub ich nur bei 3d Diagrammen benutzt aber ich benutz ein 2d kreis

safur

18.12.2020, 19:47

@TAEBoost

kannst du die Datei irgendwie bereitstellen?

vielleicht über die Orientation Eigenschaft von einem Label

Hast du die Grad irgendwo schon? Weil dann könntest du die doch einfach in eine Zelle schreiben.

TAEBoost

Beitragsersteller

19.12.2020, 18:10

@safur

ne weil die startdrehung wird am anfang zufällig durch randbetween ausgelöst und dann wird sozusagen von der startdrehung 630° gedreht... das problem ist ich kann jtz nicht einfach die stratdrehung nehmen und 630° drauf adden weil durch die ständigen 5° schritte der drehung, calculiert er randbeetwen auch neu

safur

20.12.2020, 13:13

@TAEBoost

Das passt schon, es fehlt noch ein Exit Do

If z >= 190 And z <= 205 Then
  Range("A5") = "Tod"
  Exit Do
End If

dann springt er aus der Schleife.

Klappt nicht? Hast du es dir anders vorgestellt?

TAEBoost

Beitragsersteller

20.12.2020, 13:13

Kannst du den Code bitte schreiben... Ich weiß nicht ganz genau was du meinst:

Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)


Sub Drehung()
'
' Drehung Makro
'

'

Dim i As Integer
Dim z As Integer

Range("C100").Select
Selection.ClearContents

i = 0
z = Cells(1, 1)

'Schnelles Drehen
Do Until i = 100
i = i + 1


   ActiveSheet.ChartObjects("Diagramm 2").Activate
   ActiveChart.FullSeriesCollection(1).Select
   ActiveChart.ChartGroups(1).FirstSliceAngle = z
   Range("R22").Select

   If z < 355 Then
   z = z + 5

   Else
   z = 0

   End If
   Application.Calculate
   Sleep (6)
   DoEvents
   DoEvents

   Loop

'Langsames Drehen
Do Until i = 165
i = i + 1


  ActiveSheet.ChartObjects("Diagramm 2").Activate
  ActiveChart.FullSeriesCollection(1).Select
  ActiveChart.ChartGroups(1).FirstSliceAngle = z
  Range("R22").Select
  If z >= 190 And z <= 205 Then

  Range("A5") = "Tod"


   End If

    Range("R22").Select

  If z < 358 Then
  z = z + 2

  Else
  z = 0

  End If
  Application.Calculate
  Sleep (6)
  DoEvents
  DoEvents

  Loop





End Sub

Zusatzinfo ich will dass wenn der kreis eine drehung hat zwischn 190 und 205 dass dann zb in A5 tod steht (Am besten wäre es wenn es erst in a5 steht wenn die drehung vorbei ist)

safur

20.12.2020, 13:14

@TAEBoost

Schau mal oben.

safur

20.12.2020, 13:21

@safur

Bei mir klappt es wunderbar, jetzt habe ich Angst 😱

Wenn jetzt einmal "Tod" geschrieben wurde, solltest du es natürlich auch wieder entfernen.

Sub Drehung()
Range("A5")=""

dann wird der Wert am Anfang gelöscht

TAEBoost

Beitragsersteller

20.12.2020, 13:43

@safur

kannst du bitte ma den code schreiben weil ich weiß immer nicht wo ich es einbauen soll

safur

20.12.2020, 13:46

@TAEBoost

Die stelle passt doch schon

Range("R22").Select
  If z >= 190 And z <= 205 Then
    Range("A5") = "Tod"
    Exit Do
   End If

safur

10.01.2021, 14:15

@safur

Danke

hannes1806

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

21.12.2020, 10:09

Am naheliegendsten wäre, du lässt das Marko den finalen Wert von z in eine Zelle schreiben, auf die du sich mit einer Formel beziehen kannst.

Woher ich das weiß:eigene Erfahrung – Faulheit >> Neugier >> Wissen

IchMalWiederXY

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

19.12.2020, 14:17

Hier mal eine Drehung, die ggf für dich passt.
Shape Objekt drehen (herber.de)

TAEBoost

Beitragsersteller

19.12.2020, 18:07

ich glaub irh versteht mich alle falsch... es dreht sich schon... (wenn ihr euch den code vielleicht mal anschaut ._.) aber ich wollte wissen ob jemand weiß wie man mit eincem command die grad eines kreises in einer zelle anzeigen lassen kann

IchMalWiederXY

20.12.2020, 00:09

@TAEBoost

Wenn du weißt wieviel Grad es sich gedreht hat dann mit

Range("A1").Value = "Dein Gradwert"

Ähnliche Beiträge

VBA Zellen verbinden mit schleife?

Hallo,

ich möchte mit Visual Basic in der Spalte A jeweils die 4 aufeinander folgenden Zellen miteinander verbinden. Also A4 - A7, A8 - A11 usw. In der Zeile mit range spuckt er einen Fehler und ich komme nicht drauf warum. Wäre super, wenn jemand mir helfen könnte 😁

Quellcode:

Option Explicit
Sub Merge()
Dim Counter1 As Integer
Dim Counter2 As Integer
Counter1 = 3
Counter2 = 7
Worksheets(„Tabelle1“).Activate
Do While Counter1 <= 1000
Range(Cells(Counter1,1), Cells(Counter2,1)).Select = True
Selection.Merge
Counter1 = Counter1 + 4
Counter2 = Counter2 + 4
Loop
End Sub

...zum Beitrag

Die anweisung ist in einem Namespace ungültig?

Ich habe eine Anleitung aus dem Internet für ein Zahlen generator kopiert

Dim Zahl As Integer 'zufallsgenerierte Zahl Dim Counter As Integer 'Zähler der Versuche

Private Sub btn_click_Click()

Dim Eingabe As Integer 'Eingegebene Zahl

'Zufallszahl generieren If Zahl = 0 Then Zahl = Int((Rnd() * 100) + 1) End If

'geschätzte Zahl eingeben Eingabe = tb_eingabe.Value

'Gültigkeitsprüfung If Eingabe > 100 Or Eingabe < 1 Then MsgBox ("Bitte geben Sie eine Zahl zwischen 1 und 100 ein!") tb_eingabe.Value = "" Else 'Richtige Eingabe If Eingabe = Zahl Then Cells(Counter + 2, 1) = Eingabe Cells(Counter + 2, 2) = "geschätzte Zahl richtig!"

    'Abfrage zum erneuten Spielen
    Abfrage = MsgBox("Richtig! Gebrauchte Versuche: " & Counter + 1 & vbLf & "Wollen Sie noch einmal spielen?", vbYesNo)
    If Abfrage = vbNo Then
        Application.Quit
    Else
        Columns("A:B").Select
        Selection.ClearContents
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "geschätzte Zahl"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Tipp"
        Range("A2").Select
        Zahl = 0
        Counter = 0
        tb_eingabe.Value = ""
        Exit Sub
    End If
End If

'eingegebene Zahl ist größer
If Eingabe > Zahl Then
    Cells(Counter + 2, 1) = Eingabe
    Cells(Counter + 2, 2) = "geschätzte Zahl zu groß"
    tb_eingabe.Value = ""
    Counter = Counter + 1
End If

'eingegeben Zahl ist kleiner
If Zahl > Eingabe Then
    Cells(Counter + 2, 1) = Eingabe
    Cells(Counter + 2, 2) = "geschätzte Zahl zu klein"
    Counter = Counter + 1
    tb_eingabe.Value = ""
End If

End If

End Sub

als Fehler kommen Die anweisung ist in einem Namespace ungültig wenn ich rauf klicke markiert er

Dim Zahl As Integer Dim Counter As Integer

Private Sub btn_click_Click()

(ganz oben) kann mir wer den code richtig machen?

...zum Beitrag

VBA Counter Problem?

Hallo Zusammen,

ich hab ein Problem in VBA. Ich muss bei jedem klicken auf Raten den counter +1 erhöht werden. Leider ergibt sich bei mir eine Endlos-Schleife. Brauche Hilfe.

Private Sub btnRaten_Click()
Dim Userzahl As Integer 'Eingegebene Zahl
Dim PCzahl As Integer 'Zufallszahl
Dim anzahl As Integer
Dim Ende As Boolean


anzahl = 0


PCzahl = Int((Rnd() * 100) + 1)


Userzahl = Val(tbxEingabe.Value)


Ende = False


Do Until Ende = True


anzahl = anzahl + 1


If Userzahl < PCzahl Then
lblAusgabe = "Die Zahl " & Userzahl & " ist zu klein"
Ende = False


ElseIf Userzahl > PCzahl Then
lblAusgabe = "Die Zahl " & Userzahl & " ist zu groß"
Ende = False


ElseIf Userzahl = PCzahl Then
lblAusgabe = "Gewonnen!"
Ende = True


End If


lblCounter.Caption = anzahl
Loop


End Sub

Danke für eure Hilfe.

...zum Beitrag

Hallo, ich möchte in einer Excel Datei per vba code bis zur ersten leeren zeile gehen, wie tue ich das?

ich möchte zur ersten leeren Zeile gehen und dann den rest markieren und löschen, also den kompletten Bereich ab da? BSp. A10 ist leer, dann möchte ich ab A10:z10 und abwärts alles markieren und löschen

Wie??

Sub FIND_EMPTY_CELL()

    Dim zeil As Integer
    Dim z As Integer
    Dim leerAbWo As Long

    zeil = ActiveSheet.UsedRange.Rows.Count 'letzte ausgefüllte Zeile

    For z = 8 To zeil

            If Cells(z, 1) = "" Then
                'leere Zelle gefunden
                leerAbWo = Cells(z, 1).Select 'gefundene Zelle selektieren
                'jetzt ab da an bis AA markieren und rest löschen!!!
                MsgBox leerAbWo
                Exit Sub
            End If
    Next z
End Sub

...zum Beitrag

Excel Makro, PDF versenden, Anhang klappt nicht?

Hallo, ich würde gerne eine Rechnung mit einem Makro erstellen. Soweit klappt das auch und die Mail öffnet sich auch, aber diese wird nicht als Anhang hinzugefügt. Ich komme leider nicht drauf. Ich denke, es liegt daran, dass er die Datei nicht findet, aber ich wüsste keinen Lösungsansatz. Hier der Code:

Dim Result As VbMsgBoxResult

Sub RechnungsnrUndDrucken()

Sheets("Rechnung_Video").Select

[D15] = [D15] + 1 'Rechnungsnummer 1 hochzählen

Dim sCC As String

Dim sName As String

Dim sText As String

Dim sObject As String

Dim sCompany As String

Dim sRefNr As String

Dim sTempFileName As String

If (CStr(ThisWorkbook.ActiveSheet.Name) = "Rechnung") Then

Result = MsgBox("Rechnung fertig?", vbApplicationModal Or vbQuestion Or vbYesNo)

If Result = vbNo Then Exit Sub

End If

Const DateiPfad = "C:\Temp\"

Dim DateiName As String

DateiName = DateiPfad & Range("C15") & Range("D15") & ".pdf"

Range("A1:F54").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

DateiName, Quality:=xlQualityStandard, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

Dim Nachricht As Object, OutApp As Object

Dim AWS As String

Set OutApp = CreateObject("Outlook.Application")

AWS = strFileName

'InitializeOutlook = True

Set Nachricht = OutApp.CreateItem(0)

With Nachricht

.Subject = "" & Range("A1") & "_" & Range("C15") & Range("D15")

.GetInspector.display

'.Attachments.Add ("C:\Temp\" & Range("C15") & Range("D15") & ".pdf")

End With

Set OutApp = Nothing

Set Nachricht = Nothing

End Sub

...zum Beitrag

Wie berechne ich 30 min Mittelwerte in VBA?

Hallo Zusammen ,

ich bin leider wirklich nicht fit was das Thema Makro schreiben angeht deshalb habe ich folgendes Problem:

Ich habe mehrer Spalten mit etwa 1000 Zeilen voller Daten. Es handelt sich dabei um Minutenwerte. Diese würde ich gerne in 30 min Werte zusammenfassen. Da das händisch ewig dauert bräuchte ich dafür ein Makro welches den Mittelwert bildet und 3 Spalten weiter in der ersten Zeile (wo auch der erste Werte der zur Mittelwertsberechnung rangezogen wird notiert ist). Dann soll der nächste Mittelwert mit den Folgenden 29 Minuten-Werten gebildet werden, 3 Spalten weiter unter dem vorherigen Mittelwert notiert werden.

Folgendes habe ich versucht:

Sub Halbstundenmittelwerte()

Dim i As Integer

Dim z As Integer

Dim x As Integer

Dim MW As Double

For i = 10 To 15010 Step 30

z = i

x = z + 29

Range(Hz).Select

ActiveCell.FormulaR1C1 ="= AVERAGE("Cz:Cx")"

Range(Hi).Value = MW

Next i

End Sub

Danke euch !

...zum Beitrag

VBA Input-Eingabe in Zelle eintragen?

Guten Abend,

ich möchte gerne den Inhalt aus einer Inputbox in Zelle D28 schreiben, nur leider funktioniert es nicht.

Folgendes Makro: (sicherlich nicht schön geschrieben aber es bis auf die Zelle D28)

Sub erstellen()
   Dim NeuerTabellenName As String
   Dim TabellenName As Boolean
   Dim myInput As String
   Dim WsTabelle As Worksheet
   
   myInput = InputBox("Bitte geben Sie den Namen des neuen Monates an", "Monat anlegen")
   
   For Each WsTabelle In Worksheets
   If WsTabelle.Name = myInput Then
   TabellenName = True
   Exit For
   End If
   Next WsTabelle
   If TabellenName Then
   MsgBox ("Der Monat existiert bereits. Der Vorgang wurde abgebrochen. Bitte ueberpruefen Sie Ihre Eingabe.")
   Worksheets("Admin").Select
   Else
   NeuerTabellenName = myInput
   Worksheets("Muster").Copy After:=Sheets(Sheets.Count)
   Sheets(Sheets.Count).Name = NeuerTabellenName
   Worksheets("Admin").Range(D28).Value = myInput
   Worksheets("Admin").Select
   End If
End Sub

Der Fehler muss ja hier liegen:

Worksheets("Admin").Range(D28).Value = myInput

Über eine Lösung wäre ich sehr dankbar.

Gruß

...zum Beitrag

VBA: Zwei Spalten mit Wert multiplizieren und dann addieren mit Hilfe von Makros

Hallöchen,

ich habe folgendes Problem Ich habe zwei Spalten die ich jeweils miteinander addieren möchte. Doch bevor ich diese addiere, möchte ich Spalte B mit dem Wert aus der TextBox1 multiplizieren und Spalte C mit dem Wert aus Textbox2. Danach sollen beide Spalten miteinander addiert und dann sortiert werden. Spalte D ist in diesem Fall die Ergebnisspalte. Das Programm hat auch schon funktioniert, jedoch habe ich vorher nur die spalten addiert und sortiert.

HIer mein bereits geschriebener Code:

Private Sub CommandButton1_Click()



' Prüfen ob Lastspitzen eingetragen wurden, ansonsten Fehlermeldung

        If TextBox1.Value = "" Or TextBox2.Value = "" Then
        MsgBox "Bitte geben Sie eine Lastspitze ein!"
     
Else
        
Dim wks As Excel.Worksheet
Dim lngLetzteZeile As Long
Dim Last1 As Integer
Dim Last2 As Integer
Last1 = TextBox1.Value
Last2 = TextBox2.Value  

Set wks = ActiveWorkbook.Worksheets("Vergleich")


With wks
 
lngLetzteZeile = .Cells(.Rows.Count, "B").End(xlUp).Row
If lngLetzteZeile < 15 Then Exit Sub

 With .Range("D15:D" & lngLetzteZeile)
 'berechne: D := B + C
 .FormulaR1C1 = "=RC[-2]*Last1+RC[-1]*Last2"
 'Formeln durch deren Ergebnis ersetzen
 .Value = .Value
 End With
 
With .Range("B15:D" & lngLetzteZeile)
 .Sort Key1:=.Cells(2), Order1:=xlDescending, _
 DataOption1:=xlSortTextAsNumbers, _
 SortMethod:=xlPinYin
End With

End With
End If


End Sub

...zum Beitrag

Excel VBA jede n-te Zeile finden und bei der Ausgabe die Steps ignorieren?

Moin zusammen, ich baue aktuell in VBA eine Excel Liste bzw. versuche eine auszuwerten. Ziel, jede 21ste Zeile soll ausgelesen und zusammengefasst ausgegeben werden. Leider gibt er die Werte genau in den Steps aus in denen er Sie liest und ich komme mit meinem Probieren nicht weiter. Hat jemand eine Lösung?

Hier der Code:

Sub AlternativeZeilenAuswaehlen()

Dim bereich1 As Range

Dim bereich2 As Range

Dim x As Integer

Dim y As Integer

Dim ZeilenNr As Integer

'Den Bereich auswählen

Set bereich1 = Range("'Test Yvonne Excel (2)'!E1:E30000")

Set bereich2 = Range("Tabelle1!B5:B30000")

'Zeilen zählen

ZeilenNr = bereich1.Rows.Count

ZeilenNr = bereich2.Rows.Count

'Jede zweite Zelle im Bereich durchlaufen

For x = 3 To ZeilenNr Step 21

'den Wert aus Spalte B in Spalte C eintragen

bereich2.Cells(x, 1).Offset(0, 0) = bereich1.Cells(x, 1)

End Sub

...zum Beitrag

MS Excel Makro Pausieren ohne Excel komplett zu pausieren?

Hi, Ich arbeite an einer art "Schiffe Versenken" für MS Excel und arbeite grade daran, dass man auf Zeit Spielen kann. dafür brauche ich logischerweise nen Timer, der die eingestellte Zeit Herunterzählt und das Spiel Beendet. Das war kein Großes Problem für mich, bis auf eine Sache: Das Makro funktioniert zwar, aber ich habe keinen Befehl gefunden der es zulässt, dass man, während der Timer läuft, noch das Spielfeld benutzen kann, da auch Excel pausiert wird und keine Änderung an den Zellen zulässt. Kennt einer von euch einen Befehl, bei dem nur das Makro angehalten wird und nicht das komplette Programm? Mein Makro sieht bis jetzt so aus:

Sub Schaltfläche1_Klicken()

Dim SE As Integer

Dim MN As Integer

Dim I As Integer

I = 0

Do While I = 0

I = 0

SE = Sheets("Eigene Flotte").Range("O26").Value

MN = Sheets("Eigene Flotte").Range("N26").Value

If SE > 0 Then

SE = SE - 1

Sheets("Eigene Flotte").Range("O26").Value = SE

Else

If MN > 0 Then

MN = MN - 1

SE = 59

(hier soll der Befehl zum Pausieren hin)

Sheets("Eigene Flotte").Range("O28").Value = SE

Sheets("Eigene Flotte").Range("N26").Value = MN

Else

Range("A1:L30").Value = ""

I = 1

End If

Loop

End Sub

...zum Beitrag

Name + User?

Hallo,

was müsste ich hier anpassen? Ich komme mit der Fehler Meldung nicht zurecht.

Private Declare 36 GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Function GetNTUserA() As String
  
 Dim sBuffer As String
 Dim LSize As Long
 Dim user As String
  
 sBuffer = Space$(255)
 LSize = Len(sBuffer)
  
 Call GetUserName(sBuffer, LSize)
  
 If LSize > 0 Then
  user = Left$(sBuffer, LSize - 1)
 Else
  user = vbNullString
 End If
  
 GetNTUserA = user
  
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Column = 6 Then
    Target.Offset(0, 11).Value = Date
  End If
      
    If Target.Column = 6 Then
    Target.Offset(0, 10).Value = GetNTUserA
  End If

End Sub

...zum Beitrag

VBA UserForm KeyDown Sonderzeichen werden nicht erkannt?

Hallo, ich habe eine Frage zu meinem VBA Code. Und zwar sollen verschiedene Tastatureingaben verschiedene Funktionen triggern. Bei Zahlen, Buchstaben, Plus, Minus, "&"-Zeichen, "!"-Zeichen und einige andere Tasten gehen. "*"-Zeichen, Prozent, "(" und ")" bspw. gehen jedoch NICHT (als KeyCode wird 0 zurückgegeben). Hat jemand eine Ahnung woran das liegt?

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  handleKeyDown KeyCode, Shift
End Sub

Private Sub handleKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim keyChar As String * 1
  keyChar = Chr(KeyCode)
  MsgBox (KeyCode)
  Select Case keyChar
  Case "0"
    numb0_Click
  Case "1"
    numb1_Click
  '.....
  Case Else
  End Select
  Select Case KeyCode
  Case "187"
    plus_Click
  '....
  Case Else 
  End Select
End Sub

Danke für alle Antworten,

Nicolas

...zum Beitrag

VBA Wenn eine Zelle mehrerer Spalten leer dann msgbox?

Hallo zusammen,

ich habe vor in mehreren Spalten zu kontrollieren, ob sich eine leere Zelle befindet. Wenn ja soll eine Msgbox angezeigt werdne und der Sub soll beendet werden. Wenn nicht soll er fortfahren. Allerdings kommt es bei mir zu einer Fehlermeldung "Typen unverträglich". Wo hat sich der Fehler eingeschlichen? End If befindet sich weiter unten.

Sub SendMeetingRequest_2()

Dim Bereich As Range

Set Bereich = Range("F2:H41", "B2:B41") 'Zellbereich

With Application.WorksheetFunction

Dim objOL As Object 'As Outlook.Application

Dim objAppt As Object 'As Outlook.AppointmentItem

'Const olAppointmentItem = 1

Const olMeeting = 1

Dim ReminderTime As Long

Dim lfdnr As Integer

lfdnr = 2

'Überprüfung erstellen falls Aufgaben leer sind

'lfdnr = 4

If Bereich.Value = "" Then

MsgBox "Bitte fehlende Daten eintragen"

Call Leere_zellen_hervorheben

Exit Sub

Else

Danke für eure Hilfe!

...zum Beitrag

VBA Objektvariable oder With Blockvariable nicht festgelegt?

Hallo habe folgenden Code:

Bekomme beim debuggen nach der Zeile "Objektvariable oder With-Blockvariable nicht festgelegt" Ich sehe mein Fehler leider nicht, hat jemand eine Ahnung?

Dim wbSAP As Workbook
Dim wbStamm As Workbook
Dim sapSheet As Worksheet
Dim stammSheet As Worksheet
Dim sapRange As Range
Dim stammRange As Range
Dim curSapCell As Range
Dim foundStammCell As Range
Dim nextStammRowNr As Integer
Set wbSAP = Workbooks.Open(ThisWorkbook.Path & "\SAP-Abfrage_GEN-User_SUIM.xls") 
Set wbStamm = ThisWorkbook


Set sapSheet = wbSAP.Sheets("SAP-Abfrage_GEN-User_SUIM") 
Set stammSheet = wbStamm.Sheets("Tabelle1")


Set sapRange = sapSheet.Range("B29:B105") 
Set stammRange = stammSheet.Range("F2:F81")


For Each curSapCell In sapRange  
   
foundStammCell = stammRange.Find(curSapCell.Value, LookAt:=xlWhole)     
If Not foundStammCell = curSapCell.Value Then  
       
stammSheet.Range("M" & nextStammRowNr) = sapSheet.Range("M" & curSapCell.Row).Value        
 nextStammRowNr = nextStammRowNr + 1     
Else        
stammSheet.Range("M" & foundStammCell.Row) = sapSheet.Range("M" & curSapCell.Row).Value     
End If
Next curSapCell

...zum Beitrag

Was möchtest Du wissen?

Deine Frage stellen