Makro-Start mit Hilfe eines Icons

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Makro-Start mit Hilfe eines Icons
von: John
Geschrieben am: 11.11.2003 12:57:03

Hallo alle,

ich habe da ein Problem, das auch von meinen Excel-Lehrern nicht gelöst werden konnte:

Ich importiere mittels Makro eine Tabelle, diese enthält unter anderem Zahlen-Spatlten.
Mit dem Makro werden die Zahlen im Anschluss formatiert.

Nun das Problem:

Starte ich das Makro direkt aus Visual Basic, wird das Excel-Blatt mitsamt den Werte-Spalten korrekt aufbereitet. Starte ich das gleiche Makro jedoch mit Hilfe eines Icons von der Icon-Leiste, werden die Zahlen-Spalten nicht richtig aufbereitet, sprich, die Zahlen stehen dann wie Text linksbündig in den Zellen.

Ich denke ich brauche nicht extra zu erwähnen, dass ich für einen Lösungsvorschlag enorm dankbar wäre.

Johann Kopp

Bild


Betrifft: AW: wo ist dein Makro?
von: Galenzo
Geschrieben am: 11.11.2003 13:05:33

Hallo,
es würde deine Chancen auf eine hilfreiche Antwort erhöhen, wenn du hier auch deinen Makrocode posten würdest.
Danm hat man einen Ansatzpunkt und müßte nicht aufs gradewohl mutmaßen.

mfg


Bild


Betrifft: AW: Makro-Start mit Hilfe eines Icons
von: John
Geschrieben am: 11.11.2003 14:06:18

Hey, das ging flott, schon mal herzlichen Dank!

Hier die Makros, so wie sie im Original ablaufen:

Sub KontrolldateiB()
'
' Makro1 Makro
' Makro am 15.02.2002 von Johann Kopp, Tel. 4 35 41 aufgezeichnet
'

'
On Error GoTo ende
Workbooks.OpenText FileName:=Application.Dialogs(xlDialogOpen).Show("c:\temp\Kon*.txt"), Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2))
ende:
End Sub


Sub ZeileFettWennKnotenPB()
'
' ZeileFettNeu Makro
' Makro am 13.01.2000 von Johann Kopp aufgezeichnet
'
GuV_KnotenLöschenB
b2brain_formatierenB
Do While ActiveCell.Value <> ""
If ActiveCell.Characters(Start:=1, Length:=1).Text = "P" Then
' If ActiveCell.Characters(Start:=1, Length:=1).Value = "P" Then
selection.EntireRow.Font.Bold = True
ActiveCell.Offset(1, 0).Range("A1").Select
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Loop
' b2BrainDruckvorbereitung

End Sub



Sub ZeilenAusblendenAlleSpaltenNullB()
Dim Alpha As String
Dim i As Integer

Application.ScreenUpdating = False
GuV_KnotenLöschenB
b2brain_formatierenB

Rows("2:2").Select
selection.Insert Shift:=xlDown
Range("A3:F3").Select
selection.AutoFilter
selection.AutoFilter Field:=6, Criteria1:="<>"

i = 5
Do Until zähler > 5
Alpha = Cells(i, 1)
Alpha = Left(Alpha, 1)
'Blank = Cells(i, 3) & Cells(i, 4) & Cells(i, 5)
If Left(Cells(i, 2), 1) = " " And Mid(Cells(i, 2), 2, 1) <> " " Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(i)
End If

' If UCase(Alpha) = "K" Or UCase(Alpha) = "P" Then
' If Blank = "" Then
' Cells(i, 1).EntireRow.Hidden = True
' zähler = 0
' End If
' If Cells(i, 1).EntireRow.Hidden = True Then
' GoTo weiter
' End If
If UCase(Alpha) = "P" Then
Cells(i, 1).Select
Cells(i, 1).EntireRow.Font.Bold = True
zähler = 0
End If
If UCase(Alpha) = "" Then
zähler = zähler + 1
End If
i = i + 1
weiter:
If Rows(i).EntireRow.Hidden = True Then
i = i + 1
GoTo weiter
End If
'Debug.Print i
Loop
Application.ScreenUpdating = True
KopfzeileB
b2BrainDruckvorbereitungB

End Sub


Sub ZeilenAusblendenKontenzeilenB()
Dim Alpha As String
Dim i As Integer

Application.ScreenUpdating = False
zähler = ActiveCell.SpecialCells(xlLastCell).Row
i = 1
Do Until i = zähler + 1
Alpha = Cells(i, 1)
Alpha = Left(Alpha, 1)
If UCase(Alpha) <> UCase("p") Then
Cells(i, 1).EntireRow.Hidden = True
End If


' If UCase(Alpha) = "P" Then
' Cells(i, 1).Select
' Selection.EntireRow.Font.Bold = True
' Zähler = 0
' End If
If UCase(Alpha) = "" Then
End If
i = i + 1
Loop
Application.ScreenUpdating = True

End Sub




Private Sub b2brain_formatierenB()
'
    Columns("A:A").Select
    With selection.Font
        .Name = "Courier"
        .Size = 11
        .ColorIndex = xlAutomatic
    End With
'alle Spalten in der Breite autom. anpassen
    Columns("A:B").EntireColumn.AutoFit
    
'Die Breite der Werte-Spalten einstellen
    Columns("C:R").Select
    selection.NumberFormat = "#,##0.00  ;[red](#,##0.00) ;–  ; @ "
        With selection
        .WrapText = True
'        .Orientation = 0
'        .ShrinkToFit = False
    End With
    Columns("C:F").ColumnWidth = 17
    Columns(1).ColumnWidth = 15.33
     
'Spaltenüberschriften gelb hinterlegen
    Rows("2:2").Select
    With selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    selection.Font.Bold = True
End Sub



Private Sub b2BrainDruckvorbereitungB()
'
'
    Application.ScreenUpdating = False
    Range("A1").Select
    
'Wiederzolungszeilen einrichten
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$4"
        End With
    ScreenUpdating = True
    
'Seite einrichten und in der Druckvorschau anzeigen
    With ActiveSheet.PageSetup
        .LeftFooter = "&""FuturaA Bk BT,Book""&8ZK/LBF, &D"
        .CenterFooter = "&8Seite &P von &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.3)
        .RightMargin = Application.InchesToPoints(0.3)
        .TopMargin = Application.InchesToPoints(0.7)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.7)
        .FooterMargin = Application.InchesToPoints(0.1)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 93
        .FitToPagesWide = False
        .FitToPagesTall = False
    End With
    
'Die Überschriften über den Werte-Spalten rechts aurichten
    Range("c4", "f4").HorizontalAlignment = xlRight
    Cells(1, 1).EntireColumn.Font.Bold = False
    Range("A3").Font.Bold = True
    On Error Resume Next
    ActiveSheet.HPageBreaks(1).Delete
    With Cells(1, 1).Font
        .Name = "FuturaA Bk BT"
        .Bold = True
        .Size = 11
        .ColorIndex = xlAutomatic
        .Bold = True
    End With
    Range("f4").Select
    selection.End(xlDown).Select
    letzteZelle = ActiveCell.Address
    ActiveSheet.PageSetup.PrintArea = "A$1 : " & letzteZelle
'
    ActiveWindow.SelectedSheets.PrintPreview
End Sub



Private Sub ÖffnenDialog()
    
           Application.Dialogs(xlDialogOpen).Show ("c:\Temp\kon*.txt")
End Sub


Private Sub GuV_KnotenLöschenB()
        Application.ScreenUpdating = False
        On Error GoTo ende
        Cells.Find(What:="pbilanzko", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
        zeilest = ActiveCell.Address
        zeileen = ActiveCell.SpecialCells(xlLastCell).Address
        Range(zeilest, zeileen).Select
        selection.EntireRow.Delete
ende:
End Sub




Private Sub KopfzeileB()
'   Es wird eine leere Zeile 1 eingfügt und formatiert
    Range("A1").Select
    On Error Resume Next
    selection.EntireRow.Insert
    Range("A1").Select
        With selection.Font
        .Name = "FuturaA Bk BT"
        .Bold = True
'        .FontStyle = "Book"
        .Size = 11
        .ColorIndex = xlAutomatic
        .Bold = True
    End With
    
'   Der Wert für die Überschrift wird abgefragt
    Dim mldg, titel, wert
    titel = "Überschrift 1. Zeile"
    mldg = "Bilanz ... "
    Voreinstellung = "Axxxx , 30. September 2003 "
    wert = InputBox(mldg, titel, Voreinstellung, 5000, 5000)
    Range("A1").Value = "Bilanz " & wert
End Sub



Sub A_Kontrolldatei_AuswahlB()
GoTo Start
ende:
Exit Sub
Start:
'
ChDrive "c:\" '
ChDir "c:\temp\"
Dir ("c:\temp\*.txt")

On Error GoTo ende
Workbooks.OpenText FileName:=Application.GetOpenFilename("Textdateien (*.txt), c:\temp\kon*.txt"), Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1))

ZeilenAusblendenAlleSpaltenNullB


End Sub



Bild


Betrifft: Noch was zum Thema
von: John
Geschrieben am: 11.11.2003 14:37:02

noch eine kleine Anmerkung:

wenn ich den Import-Teil und den Format-Teil getrennt starte, geht das sehr wohl alles richtig, also muss das irgendwo im Zusammenspiel mit dem Import liegen.

John


Bild

Beiträge aus den Excel-Beispielen zum Thema " hinterlegt zellen in excel"