Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1232to1236
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

PowerPoint Problem

PowerPoint Problem
Berndi
Hallo Experten !
Ich habe eine Frage bezüglich eines VBA-Scripts, das ich in PowerPoint ablaufen lassen möchte.
Da ich mit Euch immer gute Erfahrungen gemacht habe, frage ich einfach mal hier, in der Hoffnung, dass mir wieder geholfen wird, obwohl es sich explizit nicht um ein Excel-VBA-Script handelt.
Bitte verzeiht mir!
Das Script habe ich im Internet gefunden und würde es gerne an meine Bedüfnisse anpassen, aber leider klappt das so nicht und ich weiß nicht warum.
Das Script fragt die Mausposition ab und erstellt an dieser Stelle ein Textfeld.
Ich möchte an dieser Stelle aber ein s.g. Callout-Flag setzen.
Die Fuktions-ID dafür habe ich bereits herausgefunden und im Script eigefügt.
Leider tut sich nichts.
Kann sich bitte, bitte, bitte jemand mal dieses Problems annehmen ?
Tausend Dank !
Berndi
'Option Explicit
'============================================================================
' Alternative um die AddressOf() -Fkt. unter Office 97 zu ersetzen
'============================================================================
Private Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias "EbGetExecutingProj" ( _
ByRef hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" ( _
ByVal hProject As Long, _
ByVal strFunctionName As String, _
ByRef strFunctionId As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" ( _
ByVal hProject As Long, _
ByVal strFunctionId As String, _
ByRef lpfn As Long) As Long
'============================================================================
' Windowstimer setzen
'============================================================================
Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) _
As Long
'============================================================================
' Windowstimer löschen
'============================================================================
Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Public Const lngAPITIMER As Long = &H10000
Public lngTIMERID As Long

Public Function AddrOf(strFuncName As String) As Long
' gibt den Funktionszeiger einer public VBA Funktion zurück
' Parameter: strFuncName ... Funktionsname
' Return: >0 Adresse, 0 Fehler
' Aufruf zb lFuncPtr& = AddrOf("MyPublicFunc")
Dim hProject As Long, lResult As Long, lpfn As Long
Dim strID As String, strFuncNameUnicode As String
Const NO_ERROR = 0
AddrOf = 0
' Konvert strFuncName Unicode
strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
' Handle des VBA - Moduls holen
Call GetCurrentVbaProject(hProject)
If hProject  0 Then
' FunktionsID der VBA-Funktion ermitteln
lResult = GetFuncID(hProject, strFuncNameUnicode, strID)
If lResult = NO_ERROR Then
' Adresse des FunktionsID holen
lResult = GetAddr(hProject, strID, lpfn)
If lResult = NO_ERROR Then: AddrOf = lpfn
End If
End If
End Function

Sub NeuesTextfeld()
On Error Resume Next
'------------------------------------------------------------------------
' Ruft den Befehl Einfügen Textfeld (Id:=139) auf
'------------------------------------------------------------------------
CommandBars.FindControl(Id:=139).Execute
'------------------------------------------------------------------------
' Ruft den Befehl Einfügen Line Callout 3 (Id:=1177 oder 1226) auf
'------------------------------------------------------------------------
'CommandBars.FindControl(Id:=1226).Execute
'------------------------------------------------------------------------
' Startet den Windowstimer und ruft alle 100 Millisekunden die Prozedur
' "Timer_Procedure" auf
'------------------------------------------------------------------------
lngTIMERID = SetTimer(0, lngAPITIMER, 100, AddrOf("Timer_Procedure"))
End Sub


Public Sub Timer_Procedure()
On Error Resume Next
'------------------------------------------------------------------------
' Wenn die Markierung im Textfeld steht, ist das Textfeld eingefügt worden.
' Nun wird der Timer gelöscht, und es kann weitergehen mit dem Ausblenden des Randes
' Dieser bescheidene Teil stammt von Lisa
'------------------------------------------------------------------------
' If Selection.StoryType = wdTextFrameStory Then
KillTimer 0, lngTIMERID
With Selection
' .ShapeRange.Line.Visible = msoFalse
' .ShapeRange.TextFrame.MarginLeft = 0#
' .ShapeRange.TextFrame.MarginRight = 0#
' .ShapeRange.TextFrame.MarginTop = 0#
' .ShapeRange.TextFrame.MarginBottom = 0#
' .Collapse
End With
End If
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: PowerPoint Problem
04.10.2011 08:07:29
Heiko
Moin Berndi,
also bei mir (XP und Office 2007) läuft das mit 1226 und 1177.
Da taucht dann ein Rechteckt (ohne bzw. mit Rahmenlinie) mit einer abgeknickten Linie Rechts auf, wenn das ein Callout-Flag ist dann geht es bei mir.
Gruß Heiko
AW: PowerPoint Problem
04.10.2011 10:49:17
Berndi
Danke Heiko !
Dann scheint es sich hier um ein Office2010-Problem zu handeln.
Kann das bitte jemand verifizieren ?
Gruß,
Berndi
Frage noch offen !!!
04.10.2011 11:35:04
Heiko
.
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige