AW: Makro um eine Kleinigkeit ändern
11.11.2009 17:18:31
Sandra
Hallo Franz,
die HDI-Variante läuft leider nicht. er meckert darüber:
Set objListe = wks.ListObjects(1)
With objListe
Mir fällt gerade ein, durch das "in Bereich konvertieren"
.ListObjects(1).Name = "Tabelle"
.ListObjects("Tabelle").Unlist
.Cells.EntireColumn.AutoFit
ist das kopieren und einfügen glaube ich überflüssig geworden. Leider weiß ich nicht genau, welchen Teil in dem Makro dadurch überflüssig ist.
Und vielleicht kannst Du mir bei einem anderen Problem auch helfen.
Ich exportiere vom Sharepoint daten immer wieder in ein Arbeitsblatt (nachfolgend) und das Makro soll ja quasi nur die Formatierung anpassen.
Beim Exportieren wird leider immer wieder die Spaltenüberschrift (bzw. Überschriften) mit exportiert. Kann ich das Makro dahin gehend ergänzen, dass diese Überschriften ganz zum Schluss (als letze Maßnahme des Makros) gelöscht werden (die komplette Zeile)? Leider kann ich nicht einfach sagen: Zeile 23 löschen und Zeile 25 löschen etc. da ja beim jeden Exportieren eine andere Anzahl von Datensätzen exportiert wird.
Ich hoffe Du verstehst was ich meine.
Natürlich darf die erste Zeile mit den Spaltenüberschriften nicht gelöscht werden.
Noch einmal kurz zu Frage zwei:
Die Daten die ich aus dem Sharepoint exportiere werden als Tabelle in Excel eingefügt und heißen dann z. B. Tabelle_owssvr_4__1 oder Tabelle_owssvr_2 etc. Damit er diese Tabellen (egal welche) "in Bereich konvertiert" habe ich den "Befehle" geben wollen, das der Tabellenname immer Tabelle ist und das "Tabelle" immer "in Bereich konvertiert" wird. Ich glaube das hat was mit dem Tabellennamen zu tun dass HDI Variante nicht läuft.
Vielen vielen vielen Dank für Deine Hilfe.
Gruß
Sandra
P. s. So sehen die beiden Makros bei mir aus:
Sub HDI()
' HDI Makro
Dim wks As Worksheet, StatusCalc As Long
Set wks = ActiveSheet
'Makrobremsen aus
With Application
StatusCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
End With
With wks
Application.CutCopyMode = False
.Cells.Select
Selection.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
With .Cells
.VerticalAlignment = xlTop
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Font
.Name = "Calibri"
.Size = 10.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End With
.ListObjects(1).Name = "Tabelle"
.ListObjects("Tabelle").Unlist
.Cells.EntireColumn.AutoFit
End With
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub
Sub HDI_Variante()
' Nur der Listenbereich wird kopiert.
Dim wks As Worksheet, objListe As ListObject, StatusCalc As Long
Set wks = ActiveSheet
'Makrobremsen aus
With Application
StatusCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
End With
Set objListe = wks.ListObjects(1)
With objListe
With .Range
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.EntireColumn.AutoFit
With .Font
.Name = "Calibri"
.Size = 10.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
.Unlist
End With
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub
