Grafik einfügen, aber wie? Problem ist nicht so einfach in der Lösung

  • Word

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von Volker Bunge.

    Grafik einfügen, aber wie? Problem ist nicht so einfach in der Lösung

    Hallo zusammen,

    ich möchte gerne in ein Word Dokument unser Firmenlogo einfügen.

    Grundsätzlich ist das eigentlich auch kein Problem. Jetzt kommt aber der Knackpunkt: Es gibt auch Dokumente, die der Benutzer selbst erstellen kann bzw. aus vorhanden Möglichkeiten selbst zusammenstellen kann. Aktuell habe ich ein Brief, da ist an dem ersten Zeichen ein Positionsrahmen angedockt. Wenn ich jetzt an den Anfang des Dokumentes gehe und mein Makro ausführe, dann wird das Logo innerhalb des Rahmens eingefügt und ist aufgrund seiner Positionsdaten nicht mehr sichtbar.

    Ich füge einmal ein Screenshot der jetzigen Situation ein (Bild1). Hinter den schwarzen Stellen sind die grauen Textformularfelder versteckt bzw. die Absendeadresse (die in der Kopfzeile liegt).

    Visual Basic-Quellcode

    1. Sub Logo_einfügen()
    3. Const dlgSchliessen As Integer = -2
    4. Const dlgOK As Integer = -1
    5. Const dlgAbbrechen As Integer = 0
    6. Dim doc As Word.Document
    7. Dim shp As Word.Shape
    8. Dim dlg As Word.Dialog
    9. Dim bild As InlineShape
    10. Dim intButton As Integer
    11. Dim strGrafikdatei As String
    13. Call Schreibschutz_Ein_Aus(Aus)
    15. ' Aktualisierungsanzeige ausschalten
    16. Application.ScreenUpdating = False
    18. Call Grafiken_Löschen("Logo")
    20. strGrafikdatei = "C:\Logo.jpg"
    22. 'Grafik im Dokument einfügen
    23. 'If intButton = dlgOK Then
    24. Set doc = ActiveDocument
    26. With doc
    28. Set shp = .Shapes.AddPicture(FileName:=strGrafikdatei, Anchor:=doc.Paragraphs(1).Range)
    30. With shp
    32. 'Verankern
    33. .LockAnchor = True
    35. 'Seitenverhältnis fixieren
    36. .LockAspectRatio = msoTrue
    38. 'Ausrichtung am Seitenrand
    39. .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    40. .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    42. 'Obere Linke Ecke
    43. .Left = CentimetersToPoints(6.7)
    44. .Top = CentimetersToPoints(1.3)
    45. .Height = CentimetersToPoints(2.1)
    46. .Width = CentimetersToPoints(3.2)
    48. 'Hinter den Text setzen
    49. .ZOrder msoBringInFrontOfText ' msoSendBehindText
    50. .name = "Logo" & Replace(Time, ":", "")
    52. End With
    54. End With
    56. 'End If
    57. DoEvents
    59. ' Aktualisierungsanzeige ausschalten
    60. Application.ScreenUpdating = True
    62. Call Schreibschutz_Ein_Aus(Ein)
    64. End Sub
    66. Sub Schreibschutz_Ein_Aus(Optional Status As SchreibschutzStatus_ENUM = 0)
    68. Select Case Status
    69. Case 0 '"Umschalten"
    70. If ActiveDocument.ProtectionType <> wdNoProtection Then
    71. Call Abschnitt_Schützen(False)
    72. ActiveDocument.Unprotect
    73. Geschützt = 1
    74. Else
    75. If ActiveDocument.Bookmarks.Exists("NichtSchützen") = False Then
    76. Selection.EndKey Unit:=wdStory ' Ende des Dokumentens
    77. Selection.HomeKey Unit:=wdStory ' Anfang des Dokumentes
    78. Call Abschnitt_Schützen(True)
    79. ActiveDocument.Protect wdAllowOnlyFormFields, NoReset:=True
    80. End If
    81. End If
    83. Case 1 ' Aus
    84. If ActiveDocument.ProtectionType <> wdNoProtection Then
    85. On Error Resume Next
    86. Call Abschnitt_Schützen(False)
    87. ActiveDocument.Unprotect
    88. On Error GoTo 0
    89. Geschützt = 1
    90. End If
    92. Case 2 ' Ein
    93. If ActiveDocument.Bookmarks.Exists("NichtSchützen") = False Then
    94. Selection.EndKey Unit:=wdStory ' Ende des Dokumentens
    95. Selection.HomeKey Unit:=wdStory ' Anfang des Dokumentes
    96. If ActiveDocument.ProtectionType <> 2 Then
    97. On Error Resume Next
    98. Call Abschnitt_Schützen(True)
    99. ActiveDocument.Protect wdAllowOnlyFormFields, NoReset:=True
    100. On Error GoTo 0
    101. End If
    102. End If
    103. End Select
    104. End Sub
    106. Public Function Grafiken_Löschen(Welche As String)
    108. Select Case Welche
    110. Case "Es_Schreibt_Ihnen"
    112. On Error Resume Next
    114. For z = 1 To ActiveDocument.Shapes.count
    116. If InStr(1, ActiveDocument.Shapes(z).name, "Logo") > 0 Or InStr(1, ActiveDocument.Shapes(z).name, "Unterschrift") > 0 Then
    118. Else
    120. ActiveDocument.Shapes(z).Select
    121. ActiveDocument.Shapes(z).Delete
    123. End If
    125. Next z
    127. For z = 1 To ActiveDocument.Frames.count
    129. ActiveDocument.Frames(z).Select ' Frame markieren
    130. ActiveDocument.Frames(z).Delete ' und löschen (aber nur der Rahmen)
    131. Selection.Delete Unit:=wdCharacter, count:=1 ' daher Inhalt des Frames auch löschen
    133. Next z
    135. On Error GoTo 0
    137. Case "Es_Schreibt_Ihnen_Kundenservice"
    139. On Error Resume Next
    141. For z = 1 To ActiveDocument.Shapes.count
    143. If InStr(1, ActiveDocument.Shapes(z).name, "Logo") > 0 Or InStr(1, ActiveDocument.Shapes(z).name, "Unterschrift") > 0 Then
    145. Else
    147. ActiveDocument.Shapes(z).Select
    148. ActiveDocument.Shapes(z).Delete
    150. End If
    152. Next z
    154. For z = 1 To ActiveDocument.Frames.count
    156. ActiveDocument.Frames(z).Select ' Frame markieren
    157. ActiveDocument.Frames(z).Delete ' und löschen (aber nur der Rahmen)
    158. Selection.Delete Unit:=wdCharacter, count:=1 ' daher Inhalt des Frames auch löschen
    160. Next z
    162. On Error GoTo 0
    164. Case "Barcode_2_of_5_Interleaved"
    166. On Error Resume Next
    168. For z = 1 To ActiveDocument.Shapes.count
    170. If InStr(1, ActiveDocument.Shapes(z).name, "Logo") > 0 Or InStr(1, ActiveDocument.Shapes(z).name, "Unterschrift") > 0 Then
    172. Else
    174. ActiveDocument.Shapes(z).Select
    175. ActiveDocument.Shapes(z).Delete
    177. End If
    179. Next z
    181. For z = 1 To ActiveDocument.Frames.count
    183. ActiveDocument.Frames(z).Select ' Frame markieren
    184. ActiveDocument.Frames(z).Delete ' und löschen (aber nur der Rahmen)
    185. Selection.Delete Unit:=wdCharacter, count:=1 ' daher Inhalt des Frames auch löschen
    187. Next z
    189. On Error GoTo 0
    191. Case "Logo"
    193. On Error Resume Next
    195. For z = 1 To ActiveDocument.Shapes.count
    197. ' MsgBox z & " " & ActiveDocument.Shapes(z).Name
    198. If InStr(1, ActiveDocument.Shapes(z).name, "Logo") > 0 Then
    200. ActiveDocument.Shapes(z).Select
    201. ActiveDocument.Shapes(z).Delete
    203. End If
    205. Next z
    207. On Error GoTo 0
    209. Case "Unterschrift"
    211. On Error Resume Next
    213. For z = 1 To ActiveDocument.Shapes.count
    215. If InStr(1, ActiveDocument.Shapes(z).name, "Unterschrift") > 0 Then
    217. ActiveDocument.Shapes(z).Select
    218. ActiveDocument.Shapes(z).Delete
    220. End If
    222. Next z
    224. On Error GoTo 0
    226. End Select
    228. End Function


    (Der Code ist natürlich in Word, habe hier nur wegen der besseren Darstellung die VB.Net Darstellung genommen).

    Habt Ihr vielleicht eine Lösung für mein Problem?

    Wie kann ich z. Bsp. die zweite Zeile, erster Buchstabe ansteuern? Dann könnte ich damit versuchen, das Logo an die zweite Zeile zu binden. Oder kann man auch Grafiken ohne Bindung an eine Bestimmt Zeile einfügen?

    Bin mal auf die Antworten gespannt?

    Vielen Dank

    Volker
    Bilder

    • Bild1.png

      10,47 kB, 773×480, 66 mal angesehen

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Hallo zusammen,

    habe gerade selbst die Lösung gefunden

    Einfach die 1 in Zeile 29 in 20 geändert.

    Set shp = .Shapes.AddPicture(FileName:=strGrafikdatei, Anchor:=doc.Paragraphs(20).Range)

    Somit wird der 20te Absatz als Ankerpunkt für das Logo genommen.

    Ein Absatz ist ja in Word immer dann gegeben, wenn die Entertaste gedrückt wurde. Da dies die meisten machen um eine neue Zeile zu erstellen, gibt es locker mehr als 20 Absätze in einem Dokument.

    Wer diese Lösung nutzen möchte, muss ggf. einfach mal mit der Zahl spielen und schauen, was geht.

    Gruß

    Volker

Facebook
Telefonspende