Necesito eliminar un botón de salvar e incluirlo en otro..

Tengo deos botones de salvar :

  • Uno me salva la cabeza de una hoja de excel
  • el otro me salva el cuerpo de la hoja

Necesito eliminar el botón que me salva la cabeza de la hoja e incluirlo en el botón que salva el cuerpo.

Codigo del cuerpo de la hoja:

Private Sub CommandButton110_Click()
'Actualizar hoja Zuschnitte y Stecker Buchse
  'DECLARAR VARIABLES
  Dim pass As String
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, n As Long
  '
  'AMBIENTE
  Application.ScreenUpdating = False
  '
  'DATOS INICIALES
  pass = "chevo"
  If Me.TextBox14.Value = "" Then
    Call MsgBox("Diese Länge würde schon berechnet", vbInformation, "nicht speichern ")
    Exit Sub
  End If
  Set sh1 = Sheets("Zuschnitte")
  Set sh2 = Sheets("Stecker Buchse")
  i = 7               'fila inicial
  n = 0
  Do While sh1.Range("B" & i).Value <> ""
    n = sh1.Range("B" & i).Value + 1
    i = i + 1
  Loop
  'ACTUALIZAR hoja Zuschnitte
  sh1.Unprotect pass
  sh1.Range("B" & i).Value = n
  sh1.Range("C" & i).Value = TextBox16.Text 'VERBINDUNG
  sh1.Range("D" & i).Value = TextBox2.Text 'Querschnitt
  sh1.Range("E" & i).Value = TextBox17.Text 'LÄNGE
  sh1.Range("F" & i).Value = TextBox14.Text
  sh1.Range("G" & i).Value = TextBox23.Text 'ISOLATION
  sh1.Protect pass
  '
Call Main 'PROGRESS BAR
                      MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
   sh1.Protect
   End Sub

Codigo de la cabeza de la hoja:

Private Sub CommandButton111_Click()
pass = "chevo"
Sheets("Zuschnitte").Unprotect pass
If Me.TextBox20.Value = "" _
Or Me.TextBox26.Value = "" _
Or Me.TextBox25.Value = "" Then
Call MsgBox("Fehlen Elemente", vbInformation, "Projektname, Bestell-Nr oder Datum ")
Exit Sub
End If
  On Error Resume Next
'linea que produce el error (amarilla)
   Sheets("Stecker Buchse").Unprotect pass
If Err.Number > 0 Then MsgBox ("mit OK weiter")
On Error GoTo 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Sheets("Zuschnitte").Range("B3") = TextBox20.Text 'Projektname
Sheets("Zuschnitte").Range("C5") = TextBox21.Text ' BESTELLNUMMER
Sheets("Zuschnitte").Range("L3") = TextBox20.Text 'Projektname
Sheets("Zuschnitte").Range("m5") = TextBox21.Text ' BESTELLNUMMER
'Sheets("Zuschnitte").Range("E4") = TextBox26.Text ' BESTELLNUMMER
Sheets("Zuschnitte").Range("A29") = TextBox25.Text ' DATUM
Sheets("Zuschnitte").Range("A23") = TextBox48.Text ' DATUM
  On Error Resume Next
'linea que produce el error (amarilla)
Sheets("Stecker Buchse").Range("B3") = TextBox20.Text 'Projektname
Sheets("Stecker Buchse").Range("C5") = TextBox21.Text ' BESTELLNUMMER
'Sheets("Stecker Buchse").Range("E4") = TextBox26.Text ' BESTELLNUMMER
Sheets("Stecker Buchse").Range("K3") = TextBox20.Text 'Projektname
Sheets("Stecker Buchse").Range("L5") = TextBox21.Text ' BESTELLNUMMER
Sheets("Stecker Buchse").Range("A29") = TextBox25.Text ' DATUM
If Err.Number > 0 Then MsgBox ("mit OK weiter")
On Error GoTo 0
Call Main 'Progress Bar
MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
    Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
Sheets("Zuschnitte").Protect
End Sub

2 Respuestas

Respuesta
1

Una opción es que pongas el código de la cabeza de la hoja en un módulo, y lo llames desde el botón de la hoja, por ejemplo:

Creas el Módulo y añades el código del botón que quieres eliminar

Sub CabezaHoja()
pass = "chevo"
Sheets("Zuschnitte").Unprotect pass
If Me.TextBox20.Value = "" _
Or Me.TextBox26.Value = "" _
Or Me.TextBox25.Value = "" Then
Call MsgBox("Fehlen Elemente", vbInformation, "Projektname, Bestell-Nr oder Datum ")
Exit Sub
End If
  On Error Resume Next
'linea que produce el error (amarilla)
   Sheets("Stecker Buchse").Unprotect pass
If Err.Number > 0 Then MsgBox ("mit OK weiter")
On Error GoTo 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Sheets("Zuschnitte").Range("B3") = TextBox20.Text 'Projektname
Sheets("Zuschnitte").Range("C5") = TextBox21.Text ' BESTELLNUMMER
Sheets("Zuschnitte").Range("L3") = TextBox20.Text 'Projektname
Sheets("Zuschnitte").Range("m5") = TextBox21.Text ' BESTELLNUMMER
'Sheets("Zuschnitte").Range("E4") = TextBox26.Text ' BESTELLNUMMER
Sheets("Zuschnitte").Range("A29") = TextBox25.Text ' DATUM
Sheets("Zuschnitte").Range("A23") = TextBox48.Text ' DATUM
  On Error Resume Next
'linea que produce el error (amarilla)
Sheets("Stecker Buchse").Range("B3") = TextBox20.Text 'Projektname
Sheets("Stecker Buchse").Range("C5") = TextBox21.Text ' BESTELLNUMMER
'Sheets("Stecker Buchse").Range("E4") = TextBox26.Text ' BESTELLNUMMER
Sheets("Stecker Buchse").Range("K3") = TextBox20.Text 'Projektname
Sheets("Stecker Buchse").Range("L5") = TextBox21.Text ' BESTELLNUMMER
Sheets("Stecker Buchse").Range("A29") = TextBox25.Text ' DATUM
If Err.Number > 0 Then MsgBox ("mit OK weiter")
On Error GoTo 0
Call Main 'Progress Bar
MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
    Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
Sheets("Zuschnitte").Protect
End Sub

Y desde el otro botón llamas la macro. 

Añade en la siguiente parte del código la macro.

sh1.Range("E" & i).Value = TextBox17.Text 'LÄNGE
sh1.Range("F" & i).Value = TextBox14.Text
sh1.Range("G" & i).Value = TextBox23.Text 'ISOLATION
sh1.Protect pass
'
Call Main 'PROGRESS BAR
MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
Call CabezaHoja '<-Se llama la macro
Application.ScreenUpdating = True

¡Gracias! Un millón de gracias por tu respuesta rápida

Saludos

Eusebio

Yo tengo tres hojas con nombres diferentes pero no cambian esas posiciones.

cómo puedo modificar ese módulo que me sirva para todas.. cada vez que yo utilice call cabezahoja

Si quieres aprovechar el mismo módulo pon otro bloque con la hoja nueva y cambia los textbox según requieras, por ejemplo:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Sheets("Nombre Hoja").Range("B3") = TextBox20.Text 'Projektname
Sheets("Nombre Hoja").Range("C5") = TextBox21.Text ' BESTELLNUMMER
Sheets("Nombre Hoja").Range("L3") = TextBox20.Text 'Projektname
Sheets("Nombre Hoja").Range("m5") = TextBox21.Text ' BESTELLNUMMER
'Sheets("Nombre Hoja").Range("E4") = TextBox26.Text ' BESTELLNUMMER
Sheets("Nombre Hoja").Range("A29") = TextBox25.Text ' DATUM
Sheets("Nombre Hoja").Range("A23") = TextBox48.Text ' DATUM

Sheets("Zuschnitte").Range("B3") = TextBox20.Text 'Projektname
Sheets("Zuschnitte").Range("C5") = TextBox21.Text ' BESTELLNUMMER
Sheets("Zuschnitte").Range("L3") = TextBox20.Text 'Projektname
Sheets("Zuschnitte").Range("m5") = TextBox21.Text ' BESTELLNUMMER
'Sheets("Zuschnitte").Range("E4") = TextBox26.Text ' BESTELLNUMMER
Sheets("Zuschnitte").Range("A29") = TextBox25.Text ' DATUM
Sheets("Zuschnitte").Range("A23") = TextBox48.Text ' DATUM
On Error Resume Next
'linea que produce el error (amarilla)
Sheets("Stecker Buchse").Range("B3") = TextBox20.Text 'Projektname
Sheets("Stecker Buchse").Range("C5") = TextBox21.Text ' BESTELLNUMMER
'Sheets("Stecker Buchse").Range("E4") = TextBox26.Text ' BESTELLNUMMER
Sheets("Stecker Buchse").Range("K3") = TextBox20.Text 'Projektname
Sheets("Stecker Buchse").Range("L5") = TextBox21.Text ' BESTELLNUMMER
Sheets("Stecker Buchse").Range("A29") = TextBox25.Text ' DATUM
If Err.Number > 0 Then MsgBox ("mit OK weiter")
On Error GoTo 0
Call Main 'Progress Bar
MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
Application.ScreenUpdating = True

Prueba así a ver si te sirve.

Respuesta
1

Te anexo el código unificado.

Nota: Revisa tu código, si desproteges la hoja y tienes un exit sub a medio código, tienes que proteger nuevamente la hoja.

En esta actualización del código, puse las validaciones de los datos, antes de desproteger las hojas. Después desprotege, guarda datos y protege las hojas.

Private Sub CommandButton110_Click()
'Actualizar hoja Zuschnitte y Stecker Buchse
  ' DECLARAR VARIABLES
  Dim pass As String
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, n As Long
  '
  ' DATOS INICIALES
  pass = "chevo"
  If Me.TextBoX14.Value = "" Then
    Call MsgBox("Diese Länge würde schon berechnet", vbInformation, "nicht speichern ")
    Exit Sub
  End If
  If Me.TextBox20.Value = "" _
    Or Me.TextBox26.Value = "" _
    Or Me.TextBox25.Value = "" Then
    MsgBox "Fehlen Elemente", vbInformation, "Projektname, Bestell-Nr oder Datum "
    Exit Sub
  End If
  '
  Set sh1 = Sheets("Zuschnitte")
  Set sh2 = Sheets("Stecker Buchse")
  i = 7               'fila inicial
  n = 0
  Do While sh1.Range("B" & i).Value <> ""
    n = sh1.Range("B" & i).Value + 1
    i = i + 1
  Loop
  ' ACTUALIZAR hoja Zuschnitte
  sh1.Unprotect pass
  sh1.Range("B" & i).Value = n
  sh1.Range("C" & i).Value = TextBox16.Text 'VERBINDUNG
  sh1.Range("D" & i).Value = TextBox2.Text 'Querschnitt
  sh1.Range("E" & i).Value = TextBox17.Text 'LÄNGE
  sh1.Range("F" & i).Value = TextBoX14.Text
  sh1.Range("G" & i).Value = TextBox23.Text 'ISOLATION
  '
  ' Cabeza
  sh1.Range("B3") = TextBox20.Text 'Projektname
  sh1.Range("C5") = TextBox21.Text ' BESTELLNUMMER
  sh1.Range("L3") = TextBox20.Text 'Projektname
  sh1.Range("m5") = TextBox21.Text ' BESTELLNUMMER
  'sh1.Range("E4") = TextBox26.Text ' BESTELLNUMMER
  sh1.Range("A29") = TextBox25.Text ' DATUM
  sh1.Range("A23") = TextBox48.Text ' DATUM
  '
  ' ACTUALIZAR hoja Stecker Buchse
  Sh2. Unprotect pass
  sh2.Range("B3") = TextBox20.Text 'Projektname
  sh2.Range("C5") = TextBox21.Text ' BESTELLNUMMER
  'sh2.Range("E4") = TextBox26.Text ' BESTELLNUMMER
  sh2.Range("K3") = TextBox20.Text 'Projektname
  sh2.Range("L5") = TextBox21.Text ' BESTELLNUMMER
  sh2.Range("A29") = TextBox25.Text ' DATUM
  '
  Sh1. Protect pass
  Sh2. Protect pass
  'Call Main 'PROGRESS BAR
  MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
End Sub

¡Gracias! 
saludos

Eusebio

DA ME ERROR EN LA CABEZA DE LA HOJA

He ido borrando los datos y me dan error parece que la inclusión de la cabeza aquí no es una buena idea

Eusebio

¿Qué dice el mensaje de error?

Solo da error cuando acerco el maus en la zona amarilla aparecen los datos reales

¿Pero en el momento en que se detiene la macro envía un mensaje de error, qué dice ese mensaje de error?

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas