Office: (Office 365) VBA-Code überspringt einzelne Zeilen

Liebe Forumsgemeinde,
ich habe einen vba-code in word. Ganz grob, es wird eine Word-Tabelle 1x1 erzeugt, dort wird ein Bild eingefügt, anschließend wird die Tabellegröße auf die Bildgröße "gestutzt". Der Code hat in den letzten zehn Jahren problemlos funktioniert, egal auf welchem Rechner und in welcher sonstigen Umgebung.
Seit wenigen Wochen wird beim Ausführen eine Anweisung (Anpassen der Breite) übersprungen und nicht ausgeführt. Die codezeile lautet:

Selection.Tables(1).PreferredWidth = CentimetersToPoints(rMassGrosscmVorgabe)

wobei der Wert rMassGrosscmVorgabe vorher ermittelt wird (und auch korrekt ist).
Führe ich den Code Schritt-für-Schritt (F8) durch, werden alle Zeilen/Anweisungen ausgeführt.
Ich habe bereits an diversen Stellen eine Pause eingefügt:

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
DoEvents
sleep 1000

Aber das hat nicht zur Lösung geführt.
Woran kann das (noch) liegen?

Vielen Dank im Voraus und viele Grüße,
Stephel

 

Moin Stephel,

um Dir gleich eine Illusion zu nehmen: Nicht immer gibt es hier innerhalb 10 Minuten einer Rückmeldung! Es ist purer Zufall, dass ich gerade mal reinschaue

Wenn du einfach mal den Code / das Modul hier zeigst, kann man das Thema mal selbst nachstellen und vielleicht so eine Lösung finden. Word-Version nicht vergessen ;-)

Grüße

 

Hallo Bast'ler,
nachdem der Fehler bereits vor Wochen aufgetaucht ist (und mit einem händischen zurechtschieden der Tabellenränder grundsätzlich auch zu beheben ist, aber wofür bräucht's dann Makros), kann ich mit ein paar Tagen Wartezeit auf eine Antwort leben :-)

Der Code umfasst mehrere tausend Zeilen, weil da - neben dem Einfügen des Bildes - noch eine ganze Menge nebenher abläuft. Um es etwas genauer zu umreißen:
Wir verwenden unterschiedliche Digitalkameras, die alle unterschiedliche Bildformate haben. Es wird also zuerst die genaue Größe des Bildes ermittelt, dass wird das Bild auf ein einheitliches Format zurecht geschnitten, dann in die Word-Tabelle eingefügt, diese zurecht geschnitten (weil es ja ein Hoch- oder ein Querformatbild sein kann, wird die WOrd-Tabelle zunächst "zu groß" eingefügt). Anschließend wird eine Bildbeschriftung ("Bild xy") eingefügt und auch formatiert.

Wie gesagt, der Code läuft seit zig Jahren fehlerfrei durch. Ich kopiere Dir trotzdem mal die wichtigsten Stellen hier rein (die unwichtigen habe ich rausgelöscht):

rMassGrosscmVorgabe = 11.75 'cm
rMassKleincmVorgabe = 8.13 'cm
iAuflösung = 300 'dpi
strFormat = "Querformat"
strBildBezBearb = "_bearb."
strBildBezBearbNr = ""
[…]
Dim dlgPicture As Dialog
Dim iAuswahltyp As Integer
Set dlgPicture = Dialogs(wdDialogInsertPicture)
With dlgPicture
'.AllowMultiSelect = True
'.InitialView = msoFileDialogViewDetails
If .Display = 0 Then Exit Sub
strBilddateibezeichnung = .Name
iAuswahltyp = .LinkTofile
End With

Set dlgPicture = Nothing

'Der Pfad der ausgewählten/zu bearbeitenden Datei lautet

Debug.Print "Der Pfad der ausgewählten/zu bearbeitenden Datei lautet ", "<" & strBilddateibezeichnung & ">"

'welches Format hat das Bild? Hoch- oder Quer?

Dim XResolution As Long, YResolution As Long

Dim Width As Long, Height As Long, Orientation As Long

Call Bild_Info(strBilddateibezeichnung, Width, Height, XResolution, YResolution)

Orientation = 0 'Querformat

If Width < Height Then Orientation = 90 'Hochformat

Debug.Print "orientation: ", IIf(Orientation = 0, "Querformat", "Hochformat")

'' Debug.Print Now()



'entspricht es der großen Standardabmessung (11,75 x 8,13 cm) oder der kleinen Standardabmessung (7,0 x 4,85 cm) bei einer Auflösung von (XResolution x YResolution)

Debug.Print "Breite [cm]: ", Round(Width / 400 * 2.54, 2), " Höhe [cm]: ", Round(Height / 400 * 2.54, 2), " bei einer Auflösung von 400dpi"

'' Debug.Print Now()



'-> dann einfach einfügen

If statNachbearbeitet Then GoTo oeffnen




oeffnen:

'Tabelle anlegen

'Egal ob hoch ob quer, ein Tabellenfeld mit genau quadratischen Abmessungen anlegen

'Maximalwert ist die Standardbreite der Bilder rMassGrosscmVorgabe

ActiveDocument.Tables.add Range:=Selection.Range, NumRows:=1, NumColumns:= _

1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _

wdAutoFitFixed

Selection.Tables(1).Rows.HeightRule = wdRowHeightExactly

Selection.Tables(1).Rows.Height = CentimetersToPoints(rMassGrosscmVorgabe)

Selection.Tables(1).Rows.AllowBreakAcrossPages = False

Selection.Tables(1).Borders(wdBorderLeft).LineStyle = wdLineStyleNone

Selection.Tables(1).Borders(wdBorderRight).LineStyle = wdLineStyleNone

Selection.Tables(1).Borders(wdBorderTop).LineStyle = wdLineStyleNone

Selection.Tables(1).Borders(wdBorderBottom).LineStyle = wdLineStyleNone

Selection.Tables(1).Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone

Selection.Tables(1).Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone



Selection.Cells(1).LeftPadding = CentimetersToPoints(0)

Selection.Cells(1).RightPadding = CentimetersToPoints(0)


Selection.ParagraphFormat.SpaceBefore = 0

Selection.ParagraphFormat.SpaceAfter = 0

Selection.ParagraphFormat.LineUnitBefore = 0

Selection.ParagraphFormat.LineUnitAfter = 0


'Bild über Verweis auf das Original einbinden

Dim oDV As DocumentProperty

Dim objWord As Word.Document



On Error GoTo 0





Select Case iAuswahltyp

Case 0:

Case 2:

Set iShape = Selection.InlineShapes.AddPicture(FileName:= _

strBilddateibezeichnung, _

LinkTofile:=True, SaveWithDocument:=False, _

Range:=Selection.Range)

Case 1:

End Select



'Bildname und Pfad in die Bildeigenschaften schreiben

iShape.AlternativeText = strBilddateibezeichnung

iPosPktRe = InStrRev(strBilddateibezeichnung, ".")

iPosSlRe = InStrRev(strBilddateibezeichnung, "\")

strBildNr = Mid(strBilddateibezeichnung, iPosSlRe + 1, iPosPktRe - iPosSlRe - 1)

strBildNrEng = Right(strBilddateibezeichnung, Len(strBilddateibezeichnung) - iPosSlRe)

iShape.title = strBildNrEng



'eingefügtes Bild markieren...

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend



'...Rahmen darstellen

Select Case iAuswahltyp

Case 2, 1:

With Selection.InlineShapes(1)

With .Borders(wdBorderLeft)

.LineStyle = wdLineStyleDashLargeGap

.LineWidth = wdLineWidth300pt

.Color = wdColorRed

End With

With .Borders(wdBorderTop)

.LineStyle = wdLineStyleDashLargeGap

.LineWidth = wdLineWidth300pt

.Color = wdColorRed

End With

.Borders.Shadow = False

End With

End Select



'...und Eigenschaften abfragen

rHoehePts = Selection.InlineShapes(1).Height

rBreitePts = Selection.InlineShapes(1).Width



rHoehecm = Round(rHoehePts / 28.35, 2) 'Points in Zentimetern

rBreitecm = Round(rBreitePts / 28.35, 2) 'Points in Zentimetern



'Daraus kann ermittelt werden, ob es sich um ein Bild im Hoch-

'oder Querformat handelt

strFormat = "Querformat"

If rHoehePts > rBreitePts Then strFormat = "Hochformat"

' idReply = MsgBox("Bei dem Bild handelt es sich um ein Bild im " & _

strFormat & ".", vbInformation + vbOKOnly, "Digitales Bild eingefügt")


'Tabellenform bearbeiten


If strFormat = "Hochformat" Then

'Breite reduzieren auf Standardmaß

Selection.Tables(1).Columns.PreferredWidth = CentimetersToPoints(rMassKleincmVorgabe)



'zweite Spalte anhängen für die Beschriftung

Selection.InsertColumnsRight

Selection.Tables(1).Columns.PreferredWidth = CentimetersToPoints(14.75 - rMassKleincmVorgabe)

Selection.Cells(1).LeftPadding = CentimetersToPoints(0.12)

Selection.Cells(1).RightPadding = CentimetersToPoints(0.12)

Selection.Cells.VerticalAlignment = wdCellAlignVerticalBottom

Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft


'Tabellengesamtbreite auf die Schriftsatzbreite zurückstutzen

Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints

Selection.Tables(1).PreferredWidth = CentimetersToPoints(14.75)


ElseIf strFormat = "Querformat" Then

'Höhe reduzieren auf Standardmaß

Selection.Tables(1).Rows.Height = CentimetersToPoints(rMassKleincmVorgabe)



DoEvents

Sleep 1000



'Tabellengesamtbreite auf die Schriftsatzbreite zurückstutzen

Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints

Selection.Tables(1).PreferredWidth = CentimetersToPoints(rMassGrosscmVorgabe)

Selection.ParagraphFormat.KeepWithNext = True



'zweite Zeile anhängen für die Beschriftung

Selection.InsertRowsBelow 1

'führte bei mehrzeiliger Beschriftung zu kaum kontrollierbaren

'Zeilenschnitt

'Selection.Rows.HeightRule = wdRowHeightExactly

'Selection.Rows.Height = CentimetersToPoints(1.9)

'die nächsten beiden Zeilen führen zu einer automatischen Wahl der Zeilenhöhe

Selection.Rows.HeightRule = wdRowHeightAtLeast

Selection.Rows.Height = CentimetersToPoints(1)

Selection.ParagraphFormat.SpaceBefore = 6

Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast

Selection.ParagraphFormat.LineSpacing = 18


End If

Danach folgt die Beschriftung, aber da ist das Kind schon in den Brunnen gefallen; Knackpunkt ist die Stelle, in der ich den DoEvents-Befehl eingefügt habe, der aber nicht zu einer Lösung geführt hat.

Falls Du weitere Angaben benötigst, melde Dich einfach.

Vielen Dank und viele Grüße,
Stephan

 

ROFL LOL !!
Hi Stephel,

dass das Ganze kein Zweizeiler sein kann, darauf war ich gefasst, aber auf ipso facto solch ein Epos nicht!!

Zu Codes generell zwei ganz heiße Tips: Dafür gib es hier ein extra Format - zu finden rechts oben / links neben dem Disketten-Symbol Einfügen > Code. Dann ist das schon mal leichter von anderem Text abzugrenzen. Dein Code hat oben schön kompakt angefangen, aber dann hagelte es völlig unnötige Leerzeilen und für 611 Wörter braucht's echte zehn Seiten Word. Was aber vermutlich auch daran liegt, dass mein C'nP die Absatzmarken hier aus dem Forum mitgenommen hat.

Im VBE kann man so etwas dann mit meinem neuen Tatort-Reiniger aufräumen (bisher noch nur in XL getestet, aber sicher leicht an WD anpassbar[Edit: doch nicht so einfach, muss etliches XL verWorden ...]).

Dann schau mir Deinen Roman mal in Ruhe an.

Schöne Grüße ...
Mist - wie komme ich alter Sack jetzt wieder vom Boden hoch ROFL

Nachtrag: Code in Notepad++ kopieren > Strg+H Suchen und Ersetzen > reguläre Ausdrücke > \n durch nichts > zwei Mal!! rund 300 Stellen >\r\r durch \r drei Mal !!! macht aus 10 Seiten gut 140 Zeilen. Jetzt wird's Tag ;-)

 

Word-Version??!

 

So - nach nun ein wenig Vorabend-Lektüre bin ich der Meinung, dass in diesem Projekt einiges an Optimierungspotential steckt, will heißen: Besser neu bauen als reparieren. Als Grundlage denke ich mir da die EXIF-Daten der Bilder, die ganz viele Informationen liefern, die Du bisher anscheinend recht aufwändig errechnest.

Das geht allerdings über den Rahmen dieses Forums etwas hinaus, weshalb ich das mal als neues Thema auf den VBAsteleien.de aufmachen, wo es dann so etwas wie ein kleines Tutorial wird.

Dabei, das in Deine Anforderungen umzusetzen, helfe ich Dir dann gerne. Gib mir ein, zwei Tage Zeit und ich poste hier den entsprechenden Link.

Wenn du helfen willst: Poste doch mal die EXIF-Daten jeweils eines beliebigen Bildes (oder einfach jeweils ein Bild) pro verwendeter DigiCam. Dann weiß ich schon mal, wo die Reise hingeht.

Schönen Amnd noch und Grüße!

 

Na - den Link gibt's jetzt schon