Telefonbuch in VBA
08.03.2019 11:11:01
Manu
ich habe folgendes Problem seit heute Morgen,
und zwar habe ich eine Eingabemaske für ein Telefonbuch Programmiert. Bis gestern hat er die Daten auch in das Arbeitsblatt "Daten" übernommen und danach die Pivot Tabelle Aktualisiert. _
Jetzt habe wollte ich die Pivot sperren und wollte das nur bestimmte bereiche bearbeitet werden und habe dafür folgenden Code benutzt um die Pivot zu sperren:
Sub RestrictPivotTable()
'Updateby Extendoffice 20161026
Dim xpf As PivotField
Application.ScreenUpdating = False
With ActiveSheet.PivotTables(1)
.EnableDrilldown = False
.EnableFieldList = False
.EnableFieldDialog = False
.PivotCache.EnableRefresh = False
For Each xpf In .PageFields
With pf
.DragToPage = False
.DragToRow = False
.DragToColumn = False
.DragToData = False
.DragToHide = False
End With
Next xpf
End With
Application.ScreenUpdating = False
MsgBox "The pivot table has been protected!", vbInformation, "Kutools for Excel"
End Sub
leider hat das nicht funktioniert und habe es raus gelöscht. Nun wenn ich auf die Buttons der Eingabmaske drücke aktuallisiert er nicht mehr die Pivot es komtm die Fehlermeldung:
Laufzeitfehler '1004':
Aktualisierung wurde durch ein Visual Basic-Makro deaktiviert
Wenn ich den Code für die Aktualisierung rausnehme fügt er auch die Daten in meine Kontentabelle ein jedoch wird die Pivot nicht aktualisiert
Hier habe ich einmal den Kompletten Code:
Private Sub txtName_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[a-z A-Z]" = False Then KeyAscii = 0
End Sub
Private Sub txtStadt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[a-z A-Z]" = False Then KeyAscii = 0
End Sub
Private Sub UserForm_Initialize()
'Comboboxen Zuständigkeit Initialisieren
Dim rngZuständigkeit As Range
With Me.cboZuständigkeit
.List = Range("Zuständigkeit").Value
End With
'Comboboxen Zustimmung Initialisieren
Dim rngZustimmung As Range
With Me.cboZustimmung
.List = Range("Zustimmung").Value
End With
End Sub
Private Sub cboStadtFirma_Change()
'In Firma wird der Wert aus der Combobox als Variable Hinterlegt
Firma = cboStadtFirma.Value
End Sub
Private Sub cboZuständigkeit_Change()
'In Zuständigkeut wird der Wert aus der Combobox Variable Hinterlegt
Zuständigkeit = cboZuständigkeit.Value
End Sub
Private Sub cboZustimmung_Change()
'In Zustimmung wird der Wert aus der Combobox Variable Hinterlegt
Zustimmung = cboZustimmung.Value
End Sub
Private Sub txtTel_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Im Mobilfeld sind nur Zahlen erlaubt
Select Case KeyAscii
Case 48 To 57
Case Else: KeyAscii = 0
End Select
End Sub
Private Sub txtMobil_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Im Mobilfeld sind nur Zahlen erlaubt
Select Case KeyAscii
Case 48 To 57
Case Else: KeyAscii = 0
End Select
End Sub
Private Sub cmdEinfügen_Click()
'Fügt die eigetragenen Werte ins Tabellenblatt und Schließt das Formular'
intErsteLeereZeile = Range("Daten").Cells(Rows.Count, 1).End(xlUp).Row + 1
'Sucht die erste Leere Zeile
Range("Daten").Cells(intErsteLeereZeile, 1).Value = txtAdresse.Value
Range("Daten").Cells(intErsteLeereZeile, 2).Value = cboZuständigkeit.Value
Range("Daten").Cells(intErsteLeereZeile, 3).Value = obFirma.Value Or obStadt.Value
Range("Daten").Cells(intErsteLeereZeile, 4).Value = txtName.Value
Range("Daten").Cells(intErsteLeereZeile, 5).Value = txtTel.Value
Range("Daten").Cells(intErsteLeereZeile, 6).Value = txtMobil.Value
Range("Daten").Cells(intErsteLeereZeile, 7).Value = txtEmail.Value
Range("Daten").Cells(intErsteLeereZeile, 8).Value = txtAdresse.Value
Range("Daten").Cells(intErsteLeereZeile, 8).Value = txtAdresse.Value
Range("Daten").Cells(intErsteLeereZeile, 10).Value = txtCC.Value
Range("Daten").Cells(intErsteLeereZeile, 11).Value = txtInfo.Value
Range("Daten").Cells(intErsteLeereZeile, 12).Value = cboZustimmung.Value
'Optionsbottons Werte zuweisen die in die Spalte Firma oder Stadt geschrieben werden
With frmKontakt
Dim last As Integer
If obStadt.Value = True Then Range("Daten").Cells(intErsteLeereZeile, 3).Value = "Stadt"
If obFirma.Value = True Then Range("Daten").Cells(intErsteLeereZeile, 3).Value = "Firma"
End With
'Privottablle Aktuallisieren
Dim pt As PivotTable
For Each wS In ActiveWorkbook.Worksheets
For Each pt In wS.PivotTables
pt.RefreshTable
Next pt
Next wS
'Email Adresse als Hyperlinks erzeugen
Dim C As Range
Dim strFirstAdr As String
With Worksheets("Daten").Range("G1:G6000") ' strFirstAdr
End If
End With
'Schließt das Formular
Unload frmKontakt
End Sub
Private Sub cmdNeu_Click()
'Fügt die eigetragenen Werte ins Tabellenblatt und Schließt das Formular'
With frmKontakt
Dim last As Integer
intErsteLeereZeile = Range("Daten").Cells(Rows.Count, 1).End(xlUp).Row + 1
'Sucht die erste Leere Zeile
Range("Daten").Cells(intErsteLeereZeile, 1).Value = txtAdresse.Value
Range("Daten").Cells(intErsteLeereZeile, 2).Value = cboZuständigkeit.Value
Range("Daten").Cells(intErsteLeereZeile, 3).Value = obFirma.Value Or obStadt.Value
Range("Daten").Cells(intErsteLeereZeile, 4).Value = txtName.Value
Range("Daten").Cells(intErsteLeereZeile, 5).Value = txtTel.Value
Range("Daten").Cells(intErsteLeereZeile, 6).Value = txtMobil.Value
Range("Daten").Cells(intErsteLeereZeile, 7).Value = txtEmail.Value
Range("Daten").Cells(intErsteLeereZeile, 8).Value = txtAdresse.Value
Range("Daten").Cells(intErsteLeereZeile, 10).Value = txtCC.Value
Range("Daten").Cells(intErsteLeereZeile, 11).Value = txtInfo.Value
Range("Daten").Cells(intErsteLeereZeile, 12).Value = cboZustimmung.Value
'Optionsbottons Werte zuweisen die in die Spalte Firma oder Stadt geschrieben werden
If obStadt.Value = True Then Range("Daten").Cells(intErsteLeereZeile, 3).Value = "Stadt"
If obFirma.Value = True Then Range("Daten").Cells(intErsteLeereZeile, 3).Value = "Firma"
End With
'Privottablle Aktuallisieren
Dim pt As PivotTable
For Each wS In ActiveWorkbook.Worksheets
For Each pt In wS.PivotTables
pt.RefreshTable
Next pt
Next wS
'Email Adresse als Hyperlinks erzeugen
Dim C As Range
Dim strFirstAdr As String
With Worksheets("Daten").Range("G1:G6000") ' strFirstAdr
End If
End With
'Mit Unload wird das Formular im Anschluss wird das Formular neugestartet
Unload frmKontakt
frmKontakt.Show
End Sub
Private Sub cmdAbbrechen_Click()
'Schließt das Formular'
Unload frmKontakt
End Sub