FaceID viewer
Betrifft: FaceID viewer
von: nosub
Geschrieben am: 14.09.2004 12:12:45
brauche sowas wie einen FaceID viewer blos als HTML, also wo ich nachschauen kann welche FaceID welchen Button darstellt. vielen dank im vorraus
mfg flo :)
Betrifft: AW: FaceID viewer
von: Axel
Geschrieben am: 14.09.2004 13:06:32
Warum nicht als Excel-Datei?
http://www.bmsltd.ie/DLCount/DLCount.asp?file=CBList.zipDie zugehörige Webseite:
http://www.bmsltd.ie/MVP/MVPPage.aspGruß
Axel
Betrifft: AW: FaceID viewer
von: nosub
Geschrieben am: 14.09.2004 16:57:47
ne will nichts zum downloaden, da ich hier im geschäfft hocke und ich das nicht einfach so machen kann. weil wenn da doch irgendwelche viren drauf sind die mein viren scanner nicht erkennt ist das ein bisschen blöd :) deswegen so ne auflistung lieber als HTML seite oder sonst was, online muss sie halt zu betrachten sein und nicht erst downloaden.
Betrifft: AW: FaceID viewer
von: Axel
Geschrieben am: 14.09.2004 17:10:09
Tja Mr. nosub,
nach so einem Kommentar sollte ich meine Hilfe eigentlich einstellen.
Da du dich mit VBA aber gut auskennst, wird das doch eigentlich kein Problem sein, das mal eben selbst zu codieren, oder?
Ich nehme an, der gute John Green hat nichts dagegen, dass ich seine Prozedur hier öffentlich poste.
Axel
Sub ListAllFaces()
Dim i As Integer 'Tracks current FaceId
Dim j As Integer 'Tracks current column in worksheet
Dim k As Integer 'Tracks current row in worksheet
Dim ctl As CommandBarControl
Dim cb As CommandBar
If Not IsEmptyWorksheet(ActiveSheet) Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
'Create temporary command bar with single control button
'to hold control button face to be copied to worksheet
Set cb = CommandBars.Add(Position:=msoBarFloating, _
MenuBar:=False, _
temporary:=True)
Set ctl = cb.Controls.Add(Type:=msoControlButton, _
temporary:=True)
k = 1
Do While Err.Number = 0
For j = 1 To 10
i = i + 1
Application.StatusBar = "FaceID = " & i
'Set control button to current FaceId
ctl.FaceId = i
'Attempt to copy Face image to worksheet
ctl.CopyFace
'Abandont For loop and Do loop if there is an error
If Err.Number <> 0 Then Exit For
ActiveSheet.Paste Cells(k, j + 1)
Cells(k, j).Value = i
Next j
k = k + 1
Loop
Application.StatusBar = False
cb.Delete
End Sub
Code eingefügt mit
Syntaxhighlighter 2.5