Consulta sobre ChDir de macros
Junto con saludar les expongo mi problema,
Estoy generando una macro que me cree una carpeta con el nombre de una celda, me guarde un pdf de la primera hoja del libro dentro de la carpeta creada con el nombre de la misma celda y rescate datos y los ordene en una segunda hoja.
El problema es que la macro antes guardaba el pdf con el nombre del libro en una direccion en la red interna en otro pc que usamos de servidor, ahora logre que cuando guardara fuera cambiando el nombre y cree la carpeta con el nombre de una celda x hasta ahy todo bien, lo malo que ahora me guarda el pdf en mis documentos en mi pc y no en el pc en red sin haber cambiado la ruta de guardado a lo mas he llegado a que lo guarde en mi escritorio pero no puedo lograr que lo guarde nuevamente en la red y menos en la carpeta creada. Al parecer chdir me esta desconociendo XD .
Mañana subire la macros para ver si alguien me puede ayudar
1 Respuesta
Esta es la macro
Option Explicit
Sub Captura_Datos()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
MkDir ("\\Hp-pcservidor\servidor solman\Produccion\OT\" & Cells(8, 19).Value)
'
Continuar = MsgBox("guardar pdf?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Range("A1:T49").Select
ChDir ("\\Hp-pcservidor\servidor solman\Produccion\OT\" & Cells(8, 19).Value)
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Cells(8, 19).Value, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'
Continuar = MsgBox("Guardar datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("Datos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("Datos")
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(1).Range("S8")
.Cells(NewRow, 3).Value = ThisWorkbook.Sheets(1).Range("E11")
.Cells(NewRow, 4).Value = ThisWorkbook.Sheets(1).Range("O11")
.Cells(NewRow, 5).Value = ThisWorkbook.Sheets(1).Range("O13")
.Cells(NewRow, 6).Value = ThisWorkbook.Sheets(1).Range("E13")
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets(1).Range("F29")
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets(1).Range("F17")
.Cells(NewRow, 17).Value = ThisWorkbook.Sheets(1).Range("D40")
.Cells(NewRow, 13).Value = ThisWorkbook.Sheets(1).Range("E12")
.Cells(NewRow, 14).Value = ThisWorkbook.Sheets(1).Range("O94")
.Cells(NewRow, 16).Value = ThisWorkbook.Sheets(1).Range("F48")
End With
'
MsgBox "Datos Guardados", vbInformation, strTitulo
Limpiar = MsgBox("Borrar datos?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
With ActiveWorkbook.Sheets(1)
Range("D17,E11,E12,E13,O13,F29,F17,C17,D40,F47,F48").ClearContents
End With
Else
End If
'
End Sub
Es una compilación y modificación de algunas que encontré
