|
Hallo zusammen,
habe folgendes Problem, das ich hier versuche mal näher zu beschreiben:
Ich habe versucht ein Makro aufzuzeichnen, welches eine unformatierte Excel in eine "schicke" formatierte Excel verwandelt.
Folgende Schritte sind notwendig.
1)
Im ersten Schritt sollen Daten aus einer Datenbank exportiert werden, die ebend unformatiert als Excel herauskommen.
Diese Excel Datei ist eine ganz normale .xls Excel Datei. (Dieser Schritt ist im Makro natürlich nicht enthalten)
2)
Im zweiten Schritt sollen ein paar Dinge passieren, die ich nun mit dem Makro festhalten wollte:
Als Beispiel: Es soll eine jpg Datei vom Server gezogen werden, die als Logo dient, die Zeilen- und Spaltenbreiten sollen automatisch angepasst werden und es sollen beispielsweise auch Farben formatiert werden usw.
Die Laufwerksbezeichnung für das Logo sind auf allen Rechnern gleich.
Nun das Problem:
Beim Ausführen des Makros auf meinem Desktop Rechner, funktioniert dieses Makro einwandfrei. Bei meinen anderen Kollegen mit Desktop Rechner funktioniert es auch wunderbar.
Jedoch bei Kollegen, die ein Laptop als Arbeitsgerät besitzen, taucht immer wieder nach einer bestimmten Sequenz der "Fehler 400" auf.
Das heißt das Makro wird bis zu einem gewissen Punkt ausgeführt und bricht dann mit dem bekannten Fehler ab.
Wir hatten auch einen ErrorCatcher eingebaut, einen Fehler gefunden, den wir behoben haben und der "Fehler 400" taucht immernoch auf.
Könnt ihr mir sagen, warum es bei Desktop PC funktioniert und bei Notebooks nicht? Hat jemand vielleicht eine Idee?
Danke Euch im Voraus und schöne Grüße
Übrigens: Wir arbeiten mit Office 2010 und alle haben die gleich Version drauf.
Hier der Code
Sub ALL()
' Header Macro -----------------------------------
Range("A1:A4").Select
Selection.ClearContents
Rows("3:3").Select
Selection.Delete Shift:=xlUp
Range("A1:R3").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
' Column Macro -----------------------------------
Columns("A:J").Select
Range("A2").Activate
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
' Row Macro -----------------------------------
Rows("5:1000").Select
Selection.RowHeight = 63
' Autofit Macro -----------------------------------
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").ColumnWidth = 19.14
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=3
Columns("J:J").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=-3
Range("A5").Select
' SecondHeader Macro -----------------------------------
Range("A2:J2").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Rows("2:2").Select
Selection.RowHeight = 26
Rows("5:5").EntireRow.AutoFit
Range("A5:R5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = 1
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
' Bug Macro -----------------------------------
Rows("2:2").EntireRow.AutoFit
' drucken Macro -------------------------------
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "Sheet1"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(1.22047244094488)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
End With
Application.PrintCommunication = True
' fusszeile Macro --------------------------------------
Dim Tabellenblatt As Worksheet
For Each Tabellenblatt In ActiveWorkbook.Worksheets
With Tabellenblatt.PageSetup
.LeftFooter = "Mustermann AG"
.CenterFooter = Date
.RightFooter = "&10Page &P"
End With
Next Tabellenblatt
' einfuegen Macro -------------------------------
Range("A6").Select
ActiveSheet.Pictures.Insert( _
"G:\daten1\06 Ber\MAKRO DO NOT DELETE\BZI_high res.jpg").Select
Selection.ShapeRange.Height = 37.4173228346
Selection.ShapeRange.Width = 74.8346456693
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 75
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 37
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop -73.5
' Color Macro ---------------------------------
Range("A1:R3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 4860687
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A5:R5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = 1
.Color = 4860687
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A5").Select
' Remove Macro -----------------------------------
Columns("S:BH").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
' Header3th Macro
' Korrektur Macro -----------------------------------
Columns("A:R").Select
Range("A4").Activate
Columns("A:R").EntireColumn.AutoFit
Columns("G:G").ColumnWidth = 8.43
Columns("G:G").EntireColumn.AutoFit
' Disclaimer Macro -----------------------------------
Range("A4:R4").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Selection.Font.Bold = False
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ActiveCell.FormulaR1C1 = _
"hier kommt ein langer text hinein" & _
"hier kommt der zweite Text hinein"
Rows("4:4").Select
Selection.RowHeight = 25.5
End Sub
|