Como guardar datos de formulario en otro archivo que se encuentra en red?

Que tal envió primero un cordial saludo a todos acudo a ustedes para solicitar su ayuda ya que necesito saber como enviar los datos de un formulario a un archivo que se encuentra en red y es donde se concentraran los datos capturados en dicho formulario solo he podido enviarlos a otro archivo que se encuentra en la misma PC Por otra parte este formulario sera utilizado por 3 usuarios al mismo tiempo al guardar cada usuario su captura encima la información en las celdas que ya fueron ocupadas

Anexo link para descargar el archivo y puedan ver la función:

Private Sub UserForm_Initialize()
On Error Resume Next
With Sheets("Datos Aplicativo")
For a = 0 To .[a1000000].End(xlUp).Row
ComboBox1.AddItem
ComboBox1.List(a, 0) = .Cells(a + 1, 1)
ComboBox1.List(a, 1) = .Cells(a + 1, 2)
Next a
End With
Call actualizar_grilla_registros
End Sub

Private Sub CommandButton1_Click() 'grabar
Dim carta As String
On Error Resume Next
If ref_fila = "" Then

For a = 3 To 12
If Me.Controls("TextBox" & a) <> "" Then
carta = Me.Controls("TextBox" & a)
Call grabar_datos(carta)
End If
Next a

Call actualizar_grilla_registros
Call resetear
End If
End Sub

Private Sub grabar_datos(carta As String)
With Workbooks("C:\Users\FamGlez\Desktop\Liberar Cartas\Libro1.xlsx").Sheets("Hoja2")
rw = .Range("a1:a1000000").Find("").Row
.Cells(rw, 1) = ComboBox1
.Cells(rw, 2) = TextBox1
.Cells(rw, 3) = TextBox2
.Cells(rw, 4) = carta
.Cells(rw, 5) = ComboBox1.Column(1)

'formato
Set rango = .Range(.Cells(rw, 1), .Cells(rw, 5))
With rango.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With rango.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With rango.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With rango.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With rango.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With rango.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With

End With
End Sub

Private Sub buscar_Change() 'buscar
On Error Resume Next
With Workbooks("C:\Users\FamGlez\Desktop\Liberar Cartas\Libro1.xlsx").Sheets("Hoja2")
If buscar = "" Then
Call actualizar_grilla_registros
Else
ListBox1.Clear
i = 1
nxt: rw = .Range(.Cells(i, 2), .Cells(1000000, 2)).Find(buscar, lookat:=2).Row
If rw = i Then Exit Sub
ListBox1.AddItem
For a = 0 To 4
ListBox1.List(x, a) = .Cells(rw, a + 1)
Next a
ListBox1.List(x, 5) = .Cells(rw, 1).Row
x = x + 1
i = rw
GoTo nxt
End If
End With
End Sub

Private Sub ListBox1_Click()
On Error Resume Next
ComboBox1 = ListBox1.Column(0)
TextBox1 = ListBox1.Column(1)
TextBox2 = ListBox1.Column(2)
TextBox3 = ListBox1.Column(3)
ref_fila = ListBox1.Column(5)
End Sub

Private Sub CommandButton3_Click() 'modificar
On Error Resume Next
If ref_fila <> "" Then
a = MsgBox("Confirma Modificar Registro", vbExclamation + vbOKCancel, "AVISO")
If a = vbCancel Then Exit Sub
With Workbooks("C:\Users\FamGlez\Desktop\Liberar Cartas\Libro1.xlsx").Sheets("Hoja2")
rw = ref_fila
.Cells(rw, 1) = ComboBox1
.Cells(rw, 2) = TextBox1
.Cells(rw, 3) = TextBox2
.Cells(rw, 4) = TextBox3
.Cells(rw, 5) = ComboBox1.Column(1)
End With
End If
Call actualizar_grilla_registros
Call resetear
End Sub

Private Sub CommandButton4_Click() 'eliminar
On Error Resume Next
If ref_fila <> "" Then
a = MsgBox("Confirma Eliminar Registro", vbExclamation + vbOKCancel, "AVISO")
If a = vbCancel Then Exit Sub
With Workbooks("C:\Users\FamGlez\Desktop\Liberar Cartas\Libro1.xlsx").Sheets("Hoja2")
.Cells(ref_fila, 1).EntireRow.Delete
End With
Call actualizar_grilla_registros
Call resetear
End If
End Sub

Private Sub actualizar_grilla_registros()
On Error Resume Next
ListBox1.Clear
With Workbooks("C:\Users\FamGlez\Desktop\Liberar Cartas\Libro1.xlsx").Sheets("Hoja2")
For a = 0 To .Range("a1000000").End(xlUp).Row - 2
ListBox1.AddItem
For b = 0 To 4
ListBox1.List(a, b) = .Cells(a + 2, b + 1)
Next b
ListBox1.List(a, 5) = .Cells(a + 2, 1).Row
Next a
End With
End Sub

Private Sub resetear()
ComboBox1 = ""
For a = 1 To 12
Me.Controls("TextBox" & a) = ""
Next a
buscar = ""
ref_fila = ""
ComboBox1.SetFocus
End Sub

Private Sub CommandButton2_Click() 'salir
Unload Me
End Sub

1 respuesta

Respuesta

Soy muy principiante en esto pero deberás guardar el archivo en la nueva ubicación de red y luego cambiar cada línea

"C:\Users\FamGlez\Desktop\Liberar Cartas\Libro1.xlsx"

Por la nueva ruta del archivo.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas