Microsoft Excel

Herbers Excel/VBA-Archiv

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.zip

Die zugehörige Webseite: http://www.bmsltd.ie/MVP/MVPPage.asp

Gruß
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 As Integer 'Tracks current FaceId
  Dim As Integer 'Tracks current column in worksheet
  Dim 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