Shapes(1).width=0 entspricht nicht unsichtbar?
24.09.2007 16:23:00
Reinhard
nachfolgender Code ist in meiner Datei:
https://www.herber.de/bbs/user/46293.xls
Ich habe den Code frisch gebastelt, sodaß er erst mal läuft, also sind da noch viele Verbesserungsmöglichkeiten/Streichungen möglich.
Im/durch den Code sieht man Spielkarten verdeckt über das Blatt gleiten, dann werden sie aufgedeckt und verschwinden wieder. Das funktioniert.
Nur, es bleiben "Reste" der Karten sichtbar, also senkrechte "Striche". Ich weiß, mit .Visible=false/true könnte ich das beheben.
Aber was ich eigentlich wissen will, ich habe doch überall im Code nach Beendigung einer Schleife die Width-Eigenschaft der gerade benutzten Spielkarte auf Null gesetzt, wieso sehe ich da noch "Reste" ?
Wenn ich normal in einem Blatt die Spaltenbreite auf Null setze so ist das das Gleiche wie Spalte ausblenden. Gilt das für Shapes nicht?
Danke ^ Gruß
Reinhard
Gruß
Reinhard
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMillisecomds As Long)
Public Abbruch As Boolean
Sub test()
Dim Vorder As Integer, Rueck As Integer
Abbruch = False
With ActiveSheet
Endlos:
Vorder = Int((52 * Rnd) + 1)
Rueck = Int((13 * Rnd) + 1) + 52
Call Geben(Rueck)
Call Bewegen(Rueck, "zu", "nr")
Call Bewegen(Vorder, "auf", "nr")
Call Bewegen(Vorder, "zu", "nl")
Call Bewegen(Rueck, "auf", "nl")
Call Ablegen(Rueck)
With .Shapes("Bild" & Vorder)
.Left = 500
.Width = 0
End With
With .Shapes("Bild" & Rueck)
.Left = 400
.Width = 0
End With
DoEvents
If Abbruch = False Then GoTo Endlos
End With
End Sub
Sub Bewegen(Bildnummer, AufZu, linksrechts)
Dim N, X, W, L, S
S = 2
If (AufZu "auf" And AufZu "zu") Or linksrechts "nl" And linksrechts "nr" Then
MsgBox "Parameter falsch"
Exit Sub
End If
With ActiveSheet.Shapes("Bild" & Bildnummer)
If AufZu = "auf" Then
If linksrechts = "nr" Then
For N = 0 To 100 Step S
.Width = N
Sleep 1
DoEvents
Next N
.Left = 500
.Width = 0
Else 'linksrechts = "nl"
For N = 0 To 100 Step S
.Width = N
.Left = 500 - N
Sleep 1
DoEvents
Next N
.Left = 400
.Width = 0
End If
Else 'AufZu = "zu"
If linksrechts = "nl" Then
For N = 100 To 0 Step -S
.Width = N
Sleep 1
DoEvents
Next N
.Left = 500
.Width = 0
Else 'linksrechts = "nr"
For N = 0 To 100 Step S
.Width = 100 - N
.Left = 400 + N
Sleep 1
DoEvents
Next N
.Left = 400
.Width = 0
End If
End If
End With
End Sub
Sub BilderEinlesen()
Dim fs, N
Set fs = Application.FileSearch
With fs
.LookIn = "f:\"
.Filename = "*.bmp"
.Execute
For N = 1 To .FoundFiles.Count
ActiveSheet.Pictures.Insert(.FoundFiles(N)).Select
With Selection
.Name = "Bild" & N
.ShapeRange.LockAspectRatio = msoFalse
.Top = 100
.Left = 500
.Height = 140
.Width = 0
If N > 52 Then .Left = 400
End With
Next N
End With
End Sub
Sub AllesLöschen()
Dim sh
For Each sh In ActiveSheet.Shapes
If sh.Name Like "Bild*" Then sh.Delete
'If sh.Name Like "Bild*" Then sh.Visible = True
Next sh
End Sub
Sub nn()
Dim sh
For Each sh In ActiveSheet.Shapes
MsgBox sh.Name
Next sh
End Sub
Sub Beenden()
Abbruch = True
End Sub
Sub Geben(Nr)
Dim N, S
S = 4
With ActiveSheet.Shapes("Bild" & Nr)
.Left = 0
.Width = 0
For N = 0 To 100 Step S
.Width = N
Sleep 1
DoEvents
Next N
For N = 0 To 400 Step S
.Left = N
Sleep 1
DoEvents
Next N
End With
End Sub
Sub Ablegen(Nr)
Dim N, S
S = 4
With ActiveSheet.Shapes("Bild" & Nr)
.Width = 100
For N = 400 To 0 Step -S
.Left = N
Sleep 1
DoEvents
Next N
For N = 100 To 0 Step -S
.Width = N
Sleep 1
DoEvents
Next N
End With
End Sub