jondavis2015
16.02.2015, 16:16
Excel VBA mit Checkbox false letzte Eingabe Rückgängig machen

Hallo,

ich habe in einer Userform eine Checkbox die bei Aktivierung den Wert je nach check oder uncheck in einer Tabelle (KV Zähler) +1 oder -1 setzt- ein Zähler sozusagen den man mit false wieder zurücksetzen kann, falls man sich vertan hat. Das funktioniert soweit super.

In einer dritten Tabelle (Historie) soll soll nun der Wert aus Tabelle1 (Test) aus Zelle A3 genommen und in Tabelle 3 in Spalte A kopiert werden- das geschieht so, dass alte Werte nicht überschrieben, sondern die nächste freie Zelle in A belegt wird- jetzt möchte ich, dass mit False das setzen des Wertes in Tabelle 3 wieder rückgängig gemacht wird- ich habe schon vieles mit suchen und ersetzen probiert, komme aber einfach nicht zu einem richtigen Ergebnis. Wie würde da der Code aussehen?

Mein Code sieht so aus bisher:

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then

Dim loLetzte As Long
With Worksheets("Historie")
' letzte belegte Zelle in Spalte A finden
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
' nächste freie Zelle erhält den Wert aus Test Zelle A1
.Cells(loLetzte + 1, 1).Value = Worksheets("Test").Cells(3, 1).Value
End With

Sheets("KV Zähler").Select
Wert1 = Range("B6")
Wert2 = Range("D1")
erg = Wert1 + Wert2
Range("B6") = erg
Range("C6") = Range("C6") + 1
End If

If CheckBox1.Value = False Then
Sheets("KV Zähler").Select
Wert1 = Range("B6")
Wert2 = Range("D1")
erg = Wert1 - Wert2
Range("B6") = erg
Range("C6") = Range("C6") - 1
End If

End Sub
 ...zum Beitrag
Antwort
von jondavis2015
16.02.2015, 17:41

Ich find den passenden Code nicht für den false Fall ... Da ist eigentlich das Problem- im false Fall soll quasi die letzte beschriebene Zeile in A gelöscht werden

...zur Antwort
jondavis2015
19.01.2015, 12:35
Excel VBA mehrere Ranges auswählen und als Bild in die Zwischenablage kopieren

Hallo liebe Community,

ich habe ein Makro gebastelt mit dem man einen Bereich auswählen und als Bild in die Zwischenablage legen kann. Das funktioniert soweit gut. Leider funktioniert das nicht wenn man mehrere Bereiche auswählt (z.B. A1:C3 und F1:H3). In diesem Fall wird nur der erste Bereich kopiert.

Der Code sieht folgendermaßen aus:

    Sub BildKopie()

Set Bereich = Application.InputBox _
("Wählen Sie den zu exportierenden Bereich aus", Type:=8)
Range(Bereich.Address).CopyPicture

End Sub

Wie müsste man diesen Code umbauen, um mehrere Bereiche als Bild in die Zwischenablage zu kriegen?

 ...zum Beitrag
Antwort
von jondavis2015
19.01.2015, 14:28

Alternativ hätte ich auch diesen Code:

Sub Bildkopie2()

Dim Bereich As Range
Dim leZeile As Long
Dim Markierung As Range
Dim Gesamt As Range
Set Markierung = Application.InputBox("Die zu exportierenden Bereiche markieren", Type:=8)
leZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For Each Bereich In Markierung.Cells
    If Gesamt Is Nothing Then
        Set Gesamt = Range(Cells(Bereich.Row, Bereich.Column), Cells(leZeile, Bereich.Column))
        Else:
        Set Gesamt = Union(Gesamt, Range(Cells(Bereich.Row, Bereich.Column), Cells(leZeile, Bereich.Column)))
        End If
        
        
Next
Gesamt.CopyPicture
End Sub

Das funktioniert im Kern sehr gut- aber nur mit 3 Blöcken. Ich bräuchte das ganze insgesamt mit 25 Blöcken- jemand eine Idee, wie man da mit der Union-Methode weiterkommt?

 ...zur Antwort
jondavis2015
16.01.2015, 14:35
Excel VBA Pfad öffnen Makro funktioniert nicht

Hallo liebe Community, ich habe mir ein Makro gebastelt, welches einen Ordner öffnen und Zugriff auf die dort enthaltenen Dateien des Typs .doc geben soll.

Der Ordner lässt sich soweit öffnen- nur wenn man den öffnen Button drückt passiert leider nichts-

Dies ist der Code:

Sub aufmachen()

Dim strDateiName As String

With Application.FileDialog(msoFileDialogOpen)

.AllowMultiSelect = False

.InitialFileName = "C:*.doc"

If .Show = -1 Then

  strDateiName = .SelectedItems(1)

End If

End With

End Sub

Könnt ihr mir bei der Fehlersuche helfen? Viele Grüße

 ...zum Beitrag
Antwort
von jondavis2015
16.01.2015, 21:50

Coole Nummer - Dankeschön funktioniert ausgezeichnet :)

...zur Antwort