per vba formeln in absolute werte umwandeln

  • #1
H

hans jupp

Bekanntes Mitglied
Themenersteller
Dabei seit
20.06.2003
Beiträge
473
Reaktionspunkte
0
hallo,

ich würde gerne in folgendem makro, vor dem versenden, die formeln in absolute werte umwandeln:

Sub Blatt_senden()
Sheets(Druckvorschau).Copy
ActiveWorkbook.SendMail [email protected]
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True
End Sub

kann mir jemand sagen wie/wo ich das umsetzen kann?

vielen dank schonmal für eure hilfe :)

gruß,
kath.hundefriseursalon
 
  • #2
Hallo kath.hundefriseursalon,

wenn du folgendes Makro aufrufst, werden in der aktiven Mappe in allen Arbeitsblättern die Ergebnisse der Formeln in Werte gewandelt.

Aufruf: Call AlleBlaetterDerAktivenMappe_FormelnGegenWerte()

Gruß Matjes :)
Code: 
Option Explicit

Sub BlattDruckvorschauSenden()

 Const cMAILADR = [email protected]
  
 Call AktiveMappeBlattDruckvorschauSenden(cMAILADR, Datei  & ActiveWorkbook.Name)


End Sub
Private Function AktiveMappeBlattDruckvorschauSenden(Empfaenger As Variant, Betreff As String)

 Const cBLTNAME = Druckvorschau
 Const cENDUNG = .xls
 
 Dim ws As Worksheet, wsa As Worksheet, wbc As Workbook
 Dim sCopyDateinameFull As String
 Dim x As Long
 
 
 
->Blatt vorhanden ?
 On Error Resume Next
 Set ws = ActiveWorkbook.Worksheets(cBLTNAME)
 On Error GoTo 0
 If ws Is Nothing Then
  MsgBox Aktive Mappe-> & ActiveWorkbook.Name &-> enthält kein Blatt mit dem Namen-> & cBLTNAME &->.
  GoTo AUFRAEUMEN
 End If
 
 Set wsa = ActiveSheet

->Kopie der aktiven Datei erstellen und öffnen
 sCopyDateinameFull = _
  ActiveWorkbook.Path & Application.PathSeparator & _
  Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - Len(cENDUNG)) & _
  Format(Now(), _ddmmyyyy_hhnnss) & cENDUNG
 ActiveWorkbook.SaveCopyAs sCopyDateinameFull
 Set wbc = Workbooks.Open(Filename:=sCopyDateinameFull)
 
->auf Blatt Formeln gegen Werte tauschen
 Set ws = wbc.Worksheets(cBLTNAME)
 Call Blatt_FormelnGegenWerte(ws)
 
->restliche Blätter zu löschen
 On Error Resume Next
 Application.DisplayAlerts = False
 For x = wbc.Sheets.Count To 1 Step -1
  If wbc.Sheets(x).Name <> cBLTNAME Then wbc.Sheets(x).Delete
 Next
 Application.DisplayAlerts = True
 Err.Clear
 On Error GoTo 0
 If wbc.Worksheets.Count > 1 Then
  MsgBox _
   Es konnten nicht alle Blätter bis auf-> & cBLTNAME &-> gelöscht werden. & vbLf & _
   Datei:  & wbc.FullName
  GoTo AUFRAEUMEN
 End If
 
->speichern
 wbc.Save
->versenden
 On Error Resume Next
 wbc.SendMail Recipients:=Empfaenger, Subject:=Betreff
 If Err.Number <> 0 Then
  MsgBox Fehler bei Sendmail & vbLf & Description: & Err.Description
  Err.Clear
 End If
 On Error GoTo 0
->schliessen
 wbc.Close
->löschen
 Kill sCopyDateinameFull
->altes Blatt aktivieren
 wsa.Activate
AUFRAEUMEN:
 Set ws = Nothing: Set wsa = Nothing: Set wbc = Nothing
End Function

Private Function Blatt_FormelnGegenWerte(ws As Worksheet)
'Ergebisse von Formeln auf dem Blatt in Werte umsetzen
  ws.Activate
  ws.Cells.Copy
  ws.Range(A1).PasteSpecial _
   Paste:=xlPasteValues, _
   Operation:=xlNone, _
   SkipBlanks:=False, _
   Transpose:=False
  Application.CutCopyMode = False
  ws.Range(A1).Select
End Function
 
  • #3
hallo matjes,

vielen dank für die schnelle antwort.
könntest du mir noch eine änderung einarbeiten?

es soll nur die kopie des tabellenblattes Druckvorschau, vor dem automatischen versenden, in absolute werte umgewandelt werden. die originaldatei soll weiterhin mit formeln bestehen bleiben.

gruß,
kath.hundefriseursalon
 
  • #4
dann probier es mal so.

Gruß Matjes :)
Code: 
Option Explicit

Sub BlattDruckvorschauSenden()

 Const cMAILADR = [email protected]> [email protected]
  
 Call AktiveMappeBlattDruckvorschauSenden(cMAILADR, Datei  & ActiveWorkbook.Name)


End Sub
Private Function AktiveMappeBlattDruckvorschauSenden(Empfaenger As Variant, Betreff As String)

 Const cBLTNAME = Druckvorschau
 Const cENDUNG = .xls
 
 Dim ws As Worksheet, wsa As Worksheet, wbc As Workbook
 Dim sCopyDateinameFull As String
 Dim x As Long
 
 
 
->Blatt vorhanden ?
 On Error Resume Next
 Set ws = ActiveWorkbook.Worksheets(cBLTNAME)
 On Error GoTo 0
 If ws Is Nothing Then
  MsgBox Aktive Mappe-> & ActiveWorkbook.Name &-> enthält kein Blatt mit dem Namen-> & cBLTNAME &->.
  GoTo AUFRAEUMEN
 End If
 
 Set wsa = ActiveSheet

->Kopie der aktiven Datei erstellen und öffnen
 sCopyDateinameFull = _
  ActiveWorkbook.Path & Application.PathSeparator & _
  Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - Len(cENDUNG)) & _
  Format(Now(), _ddmmyyyy_hhnnss) & cENDUNG
 ActiveWorkbook.SaveCopyAs sCopyDateinameFull
 Set wbc = Workbooks.Open(Filename:=sCopyDateinameFull)
 
->auf Blatt Formeln gegen Werte tauschen
 Set ws = wbc.Worksheets(cBLTNAME)
 Call Blatt_FormelnGegenWerte(ws)
 
->restliche Blätter zu löschen
 On Error Resume Next
 Application.DisplayAlerts = False
 For x = wbc.Sheets.Count To 1 Step -1
  If wbc.Sheets(x).Name <> cBLTNAME Then wbc.Sheets(x).Delete
 Next
 Application.DisplayAlerts = True
 Err.Clear
 On Error GoTo 0
 If wbc.Worksheets.Count > 1 Then
  MsgBox _
   Es konnten nicht alle Blätter bis auf-> & cBLTNAME &-> gelöscht werden. & vbLf & _
   Datei:  & wbc.FullName
  GoTo AUFRAEUMEN
 End If
 
->speichern
 wbc.Save
->versenden
 On Error Resume Next
 wbc.SendMail Recipients:=Empfaenger, Subject:=Betreff
 If Err.Number <> 0 Then
  MsgBox Fehler bei Sendmail & vbLf & Description: & Err.Description
  Err.Clear
 End If
 On Error GoTo 0
->schliessen
 wbc.Close
->löschen
 Kill sCopyDateinameFull
->altes Blatt aktivieren
 wsa.Activate
AUFRAEUMEN:
 Set ws = Nothing: Set wsa = Nothing: Set wbc = Nothing
End Function

Private Function Blatt_FormelnGegenWerte(ws As Worksheet)
'Ergebisse von Formeln auf dem Blatt in Werte umsetzen
  ws.Activate
  ws.Cells.Copy
  ws.Range(A1).PasteSpecial _
   Paste:=xlPasteValues, _
   Operation:=xlNone, _
   SkipBlanks:=False, _
   Transpose:=False
  Application.CutCopyMode = False
  ws.Range(A1).Select
End Function
 
  • #5
leider bekomme ich den code nicht zum laufen. es kommt eine fehlermeldung: laufzeitfehler 1004, anwendungs- oder objektorientierter fehler.

wäre es eventuell einfacher, daß tabellenblatt druckvorschau erst in der ursprünglichen datei zu kopieren, dann die formeln in absoute werte umzuwandeln, anschließend zu verschicken und dann das blatt mit den absoluten werten wieder zu löschen?

gruß,
kath.hundefriseursalon
 
  • #6
hallo kath.hundefriseursalon,

so wie es passieren soll ist das schon i.O. - man kann nur ganze Mappen verschicken und nicht einzelne Blätter !

Wenn der Laufzeitfehler auftritt und du Debug wählst, was steht dann in der markierten Zeile ?
Also bei welchem Befehl tritt der Laufzeitfehler auf ?
Welche Excel-Version benutzt du ?

Gruß Matjes :)
 
  • #7
hallo matjes,

ich arbeite mit office 2003 SP3.

die fehlermeldung kommt in der zeile:
If wbc.Sheets(x).Name <> cBLTNAME Then wbc.Sheets(x).Delete

kann es sein, daß es an einem aktiven blattschutz mit kennwort liegt?

gruß,
kath.hundefriseursalon
 
  • #8
Hallo kath.hundefriseursalon,

ich hab das Makro (siehe oben ) modifiziert und diesbezüglich Prüfung/Meldung eingebaut.
Probier's mal aus und schau mal ob er ein Blatt nicht löschen kann. Für eine Probedatei wäre ich dann dankbar(kannst die Daten weitgehend löschen, nur der Schreibschutz sollte darin enthalten sein).

Ich hab mit einem normalen Blattschutz keine Probleme gehabt.

Gruß Matjes :)
 
  • #9
hallo matjes,

jetzt funktioniert es.
ich habe aber noch ein anderes problem, daher habe ich dir die datei mal gemailt.

gruß,
kath.hundefriseursalon
 
Thema:

per vba formeln in absolute werte umwandeln

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums

Themen
113.840
Beiträge
707.963
Mitglieder
51.494
Neuestes Mitglied
Flensburg45
Oben