[VBA] einzelnes Arbeitsblatt abspeichern

[snb]

wenn ich den Code in die Zwischenablage kopiere und in den VBA-Editor einfüge, sind dort keine Farben drin.

Ich meine die Code tags die du hier im Forum verwendest:

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel

[Rabe]

Hi,

Ich meine die Code tags die du hier im Forum verwendest:

die meinte ich auch.

Wenn ich im Forum das bunte Makro mit STRG-C und STRG-V in den VBA-Editor von Excel einfüge, ist nichts mehr farbig.

[snb]

Wenn ich das hier im Forum in eine Antwort einfüge ist es schrecklich.

[Rabe]

Hi,

es gibt zwei Möglichkeiten zum Antworten:

einmal über den Zitatantwort-Button, dort wird das Makro mit der HTML_Formatierung zitiert. In der Vorschau und im abgesendeten Beitrag kommt es korrekt:

ich habe es jetzt so gemacht:

Sub M_snb_erweitert()

  strPfadDatei = ThisWorkbook.Path & "\" & ThisWorkbook.Name

  With ThisWorkbook.Sheets("sheet4")

     .ExportAsFixedFormat 0, "C:\temp\" & Cells(23, 11) & ".pdf"

     .Shapes.SelectAll

     Selection.Cut

     Application.DisplayAlerts = False

     .SaveAs "C:\temp\" & Cells(23, 11) & ".xlsx", 51

     .Paste

  End With

  ThisWorkbook.SaveAs strPfadDatei & ".xlsb", 50

End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 15

zum anderen, über den Antworten-Button, dort muß das Zitat manuel eingefügt werden.
Das Makro aus dem Ursprungsbeitrag kopiert und eingefügt, kommt es ohne Farben:

Sub M_snb_erweitert()
  strPfadDatei = ThisWorkbook.Path & "\" & ThisWorkbook.Name
  With ThisWorkbook.Sheets("sheet4")
     .ExportAsFixedFormat 0, "C:\temp\" & Cells(23, 11) & ".pdf"
     .Shapes.SelectAll
     Selection.Cut
     Application.DisplayAlerts = False
     .SaveAs "C:\temp\" & Cells(23, 11) & ".xlsx", 51
     .Paste
  End With
  ThisWorkbook.SaveAs strPfadDatei & ".xlsb", 50
End Sub


Das Makro aus dem Ursprungsbeitrag kopiert und mit dem Zitate-Blase-Button (quote-Tags erzeugt) und dann eingefügt, kommt es auch ohne Farben:

Sub M_snb_erweitert()
  strPfadDatei = ThisWorkbook.Path & "\" & ThisWorkbook.Name
  With ThisWorkbook.Sheets("sheet4")
     .ExportAsFixedFormat 0, "C:\temp\" & Cells(23, 11) & ".pdf"
     .Shapes.SelectAll
     Selection.Cut
     Application.DisplayAlerts = False
     .SaveAs "C:\temp\" & Cells(23, 11) & ".xlsx", 51
     .Paste
  End With
  ThisWorkbook.SaveAs strPfadDatei & ".xlsb", 50
End Sub

mit quote und code-Tags ebenfalls:

Code:

Sub M_snb_erweitert()
  strPfadDatei = ThisWorkbook.Path & "\" & ThisWorkbook.Name
  With ThisWorkbook.Sheets("sheet4")
     .ExportAsFixedFormat 0, "C:\temp\" & Cells(23, 11) & ".pdf"
     .Shapes.SelectAll
     Selection.Cut
     Application.DisplayAlerts = False
     .SaveAs "C:\temp\" & Cells(23, 11) & ".xlsx", 51
     .Paste
  End With
  ThisWorkbook.SaveAs strPfadDatei & ".xlsb", 50
End Sub

Das einzige, wo die Farben erscheinen, ist bei der Zitatantwort. Wenn dann der Code noch nachbearbeitet wird (da sind die HTML-Tags drin) ist es kompliziert, aber wer ändert einen zitierten Code im Zitat?

[Rabe]

ich habe es jetzt so gemacht:

komischerweise kommt seit heute folgender Fehler beim wieder Einfügen der Buttons:
Laufzeitfehler '438'
Objekt unterstützt diese  Eigenschaft oder Methode nicht

in der Zeile:
.Range("D1").Paste

Wenn ich es so mache:
.Range("D1").Select
Selection.Paste
stoppt der Code ebenfalls beim Paste

Hier der Code:

Code:

Sub Rechnung_ablegen()
 
  ActiveSheet.Unprotect Passwort
 
  strPfadDatei = ThisWorkbook.Path & "\" & ThisWorkbook.Name      'sichern Pfad und Name
  With Sheets("RechnungsVorlage")
     '.PrintOut
     .ExportAsFixedFormat 0, "C:\Temp\" & .[K23] & ".pdf"            'Definition des Datei-/Blattnamens, Pfad anpassen!
     .Shapes.SelectAll
     Selection.Cut
     Application.DisplayAlerts = False
     .SaveAs "C:\Temp\" & .[K23] & ".xlsx", 51                       'aktuelle Rechnung als extra Datei abspeichern, Pfad anpassen!
     .Range("D1").Paste
     
     Sheets("Datenbankliste").Cells(Rows.Count, 2).End(xlUp).Offset(1, -1).Resize(, 39) = Array(.[K22], .[C16], .[C17], .[C18], .[C19], .[C20], .[C21], .[K23], .[K21], _
         .[C30], .[D30], .[F30], .[G30], .[H30], .[J30], .[C36], .[D36], .[F36], .[G36], .[H36], .[J36], .[C42], .[D42], .[F42], .[G42], .[H42], .[J42], .[K51], .[K52], .[K54], _
         .[D32], .[D33], .[D34], .[D38], .[D39], .[D40], .[D44], .[D45], .[D46])
  End With
  With Sheets("Datenbankliste")
     loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row                  ' letzte belegte in Spalte A (1)
     .Range("I" & loLetzte).NumberFormat = "dd.mm.yyyy"
     strReNr = WorksheetFunction.Max(.Range("H2:H" & loLetzte)) + 1
  End With
  Sheets("RechnungsVorlage").[K23] = strReNr
  ThisWorkbook.SaveAs strPfadDatei & ".xlsb", 50                     'Datei wieder unter Original-Name abspeichern
 
'   ActiveSheet.Protect Passwort

End Sub

[atilla]

Hallo Ralf,

Ich verstehe zwar nicht, was Du noch pasteurisieren möchtest, aber es ist so, das nach dem Speichern die Paste weg ist.


Warum sollte das nicht ohne Select gehen:

Range("A1").CurrentRegion.Copy
   ThisWorkbook. Sheets("Hilfstabelle").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False

[RPP63]

Hi!
Ergänzend:
Es gibt keine .Paste-Methode für ein Range-Objekt!

Entweder
Range1.Copy Range2 (man kann, muss aber nicht, den benannten Parameter Destination:= angeben)

oder
Range1.Copy
Range2.PasteSpecial (mit den üblichen Parametern)

Gruß Ralf

[Rabe]

Hallo,

@atilla und Ralf:

in dem abzuspeichernden Tabellenblatt sind 3 Buttons (Shapes, in D1, F1 und G1). Diese werden ausgeschnitten und dann das aktuelle Blatt als Excel-Datei abgespeichert und dann die Buttons mit Paste in D1 als Zieladresse eingefügt.

Das hat bis gestern noch funktioniert. Davor hatte ich nur .Paste drin, da hat Excel es in die letzte angeklickte Zelle eingefügt.

Seit heute geht es nicht mehr.

Ich habe es jetzt so geändert:

Code:

     .Range("D1").Select
     .Paste
     Application.CutCopyMode = False
     .Range("C16").Select

[atilla]

Hallo Ralf,

Du versteifst Dich auf Code, weil sie kurz und einfach erscheinen.
Die Codes von snb sind nicht von schlechten Eltern. Aber ich würde in Deinem Fall etwas mehr Code nutzen und mir die Arbeit aber wesentlich vereinfachen.

Für mich wäre folgendes recht einfach zu erledigen (hatte ich schon Edgar geschrieben):
Das Blatt wird zuerst kopiert und dann als Pdf exportiert sowie die Shapes ausgeschnitten und als .xlsx abgespeichert.

Das habe ich mal in Deinen bestehenden Code eingearbeitet.

Code:

Sub Rechnung_ablegen()



 strPfadDatei = ThisWorkbook.Path & "\" & ThisWorkbook.Name      'sichern Pfad und Name
 ActiveSheet.Unprotect Passwort
 Sheets("RechnungsVorlage").Copy
 With ActiveWorkbook
    '.Print
    .ExportAsFixedFormat 0, "C:\Temp\" & Sheets("RechnungsVorlage").[K23] & ".pdf"            'Definition des Datei-/Blattnamens, Pfad anpassen!
    .Sheets("RechnungsVorlage").Shapes.SelectAll
    Selection.Cut
    Application.DisplayAlerts = False
    .SaveAs "C:\Temp\" & Sheets("RechnungsVorlage").Range("K23") & ".xlsx", 51                       'aktuelle Rechnung als extra Datei abspeichern, Pfad anpassen!
   
   
 .Close
 End With
 
 With Sheets("RechnungsVorlage")
      Sheets("Datenbankliste").Cells(Rows.Count, 2).End(xlUp).Offset(1, -1).Resize(, 39) = Array(.[K22], .[C16], .[C17], .[C18], .[C19], .[C20], .[C21], .[K23], .[K21], _
        .[C30], .[D30], .[F30], .[G30], .[H30], .[J30], .[C36], .[D36], .[F36], .[G36], .[H36], .[J36], .[C42], .[D42], .[F42], .[G42], .[H42], .[J42], .[K51], .[K52], .[K54], _
        .[D32], .[D33], .[D34], .[D38], .[D39], .[D40], .[D44], .[D45], .[D46])
 End With
 
 
 With Sheets("Datenbankliste")
    loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row                  ' letzte belegte in Spalte A (1)
    .Range("I" & loLetzte).NumberFormat = "dd.mm.yyyy"
    strReNr = WorksheetFunction.Max(.Range("H2:H" & loLetzte)) + 1
 End With
 Sheets("RechnungsVorlage").[K23] = strReNr
 ThisWorkbook.SaveAs strPfadDatei & ".xlsb", 50                     'Datei wieder unter Original-Name abspeichern

'   ActiveSheet.Protect Passwort

End Sub

[Rabe]

Hi atilla,

Du versteifst Dich auf Code, weil sie kurz und einfach erscheinen.
Die Codes von snb sind nicht von schlechten Eltern. Aber ich würde in Deinem Fall etwas mehr Code nutzen und mir die Arbeit aber wesentlich vereinfachen.

ja, ich dachte, es geht etwas schneller als das Kopieren, aber das ist nur ein marginaler Zeit-Unterschied.

Nun habe ich es umgestellt und es ist ja von den Zeilen her auch nicht mehr, als meine Lösung mit den Selects.
Danke.

Es erstaunte mich nur, daß ich solche Probleme hatte, die Selects zu entfernen. Das Gleiche hatte ich heute auch schon in einer Datei in der Firma, da konnte ich solche Zeilen auch nicht zusammenfassen.