24.01.2013

PowerPoint - New Presentation - Slide add - TextFrame...

Frage: Ich möchte In Powerpoint Rechtecke erzeugen und Text reinschreiben. Wie geht das?

I want to create in PowerPoint rectangles and write in text. How does it work?

Hier noch eine Beispieldatei / Here's a sample file:
PowerPoint - New Presentation - Slide add - TextFrame...[XLS 40 KB]

Option Explicit
' Leeres Slide in PowerPoint 
Const ppLayoutBlank As Long = 12
' Objektvariable für Applikation 
Dim objPP As Object
'-------------------------------------------------------------------------- 
' Module    : Module1 
' Procedure : Main 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 24.01.2013 
' Purpose   : PowerPoint - New Presentation - Slide add - TextFrame... 
'-------------------------------------------------------------------------- 
Public Sub Main()
    ' Variablendeklaration 
    Dim intHeight As Integer
    Dim intWidth As Integer
    Dim intCount As Integer
    Dim objPPDoc As Object
    Dim intLeft As Integer
    Dim intTop As Integer
    Dim intTMP As Integer
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke 
    On Error GoTo Fin
    ' Die Abmasse bzw. der Abstand 
    intHeight = 60
    intWidth = 100
    intCount = 10
    intLeft = 10
    intTop = 10
    ' PowerPoint starten 
    ' Wenn PowerPoint ausgeblendet werden soll, dann so: 
    ' http://vbanet.blogspot.de/2010/09/excel-powerpoint.html 
    Set objPP = OffApp("PowerPoint")
    If Not objPP Is Nothing Then
        With objPP
            ' Neue Präsentation 
            .Presentations.Add
            ' Neues LEERES Slide 
            .ActivePresentation.Slides.Add 1, ppLayoutBlank
            Set objPPDoc = .ActivePresentation.Slides(1)
        End With
        For intTMP = 1 To 5
            ' Shape Rechteck hinzufügen 
            With objPPDoc.Shapes.AddShape _
                (msoShapeRectangle, 0, 0, intWidth, intHeight)
                ' Text reinschreiben 
                .TextFrame.TextRange.Text = "Test " & intTMP
                ' Schriftgrösse 
                .TextFrame.TextRange.Font.Size = 14
                ' Abstand oben 
                .Top = intCount
                ' Abstand links 
                .Left = intLeft
                ' Für die nächste Plazierung hochzählen 
                intCount = intCount + .Height + intTop
            End With
        Next intTMP
    Else
        MsgBox "Application not installed!"
    End If
Fin:
    ' Objektvariablen zurücksetzen 
    Set objPPDoc = Nothing
    Set objPP = Nothing
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung 
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'-------------------------------------------------------------------------- 
' Module    : Module1 
' Procedure : OffApp 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 24.01.2013 
' Purpose   : Start application... 
'-------------------------------------------------------------------------- 
Private Function OffApp(ByVal strApp As String, _
    Optional blnVisible As Boolean = True) As Object
    On Error Resume Next
    Set objPP = GetObject(, strApp & ".Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objPP = CreateObject(strApp & ".Application")
            If blnVisible = True Then
                On Error Resume Next
                objPP.Visible = True
                Err.Clear
            End If
    End Select
    On Error GoTo 0
    Set OffApp = objPP
    Set objPP = Nothing
End Function

Formeln auf einer UserForm in einer TextBox darstellen...

Formeln auf einer UserForm in einer TextBox anzeigen. Z. B. "Formula", "FormulaLocal"... und wie muss die Formel in VBA ...