Jump to content

joshua

Members
  • Content Count

    935
  • Joined

  • Last visited

  • Days Won

    8

joshua last won the day on November 19 2015

joshua had the most liked content!

About joshua

  • Rank
    Advanced Member
  • Birthday 02/10/1968

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. Saludos. En cmdGuardar deja la ultima parte de la siguiente forma: VaciarCabecera VaciarCuerpo Página = 1 CargarPágina Aviso = Página & "/" & Páginas 'parte que se agrego txtFecha.SetFocus Set h1 = Sheets("Ingreso") End Sub Atte. joshua
  2. Saludos. No se si entendí bien anula la siguiente linea en cmdGuardar Página = 1 Atte. joshua
  3. Saludos. Prueba con la siguiente macro. Sub prueba() Dim i, finH1, finH2 As Integer Application.ScreenUpdating = False With Sheets("Hoja2") finH2 = .Range("A60000").End(xlUp).Row .Range("D2").Value = 1 .Range("D2").AutoFill Destination:=.Range("D2:D" & finH2), Type:=xlFillSeries With Sheets("Hoja1") finH1 = .Range("A60000").End(xlUp).Row For i = 3 To finH1 If Not IsEmpty(.Cells(i, 1)) And IsNumeric(.Cells(i, 1)) Then With Sheets("Hoja2") .Range("A1:D" & finH2).AutoFilter Field:=1, Criteria1:=Cells(i, 1) .AutoFilter.Sort.SortFields.Add Key:=.Range( _ "C2:C" & finH2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal .AutoFilter.Sort.Apply If .Range("A60000").End(xlUp).Row > 1 Then .Range("B2:C" & finH2).SpecialCells(xlCellTypeVisible).Copy Sheets("Hoja1").Cells(i + 1, 2).PasteSpecial Paste:=xlValues, Transpose:=True Application.CutCopyMode = False End If .ShowAllData End With End If Next i End With .AutoFilter.Sort.SortFields.Add Key:=.Range( _ "D2:D" & finH2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal .AutoFilter.Sort.Apply .Range("D2:D" & finH2).Clear .Range("A1:D" & finH2).AutoFilter Sheets("Hoja1").Range("A1").Select End With Application.ScreenUpdating = True End Sub Atte. joshua
  4. Saludos. Corrígeme si me equivoco. 1.-Tienes una base de datos con datos ya gravados. 2.-Quieres buscar en ella items para editarlos. Seria bueno que adjuntaras un ejemplo de la hoja base con los nombres de todas las columnas que vas a manejar con datos ficticios para ver cual seria la mejor forma de manejar la gestión de la base. Atte. joshua
  5. Saludos. Debes adjuntar un archivo. Atte. joshua
  6. Saludos. Paciencia recuerda que los que tratamos de ayudar tambien tenemos ocupaciones que atender, ademas de tratar de ayudar a otros compañeros de mi parte ten presente que tu post no lo e olvidado, como te reitero paciencia. Atte. joshua
  7. Saludos. Prueba con la siguiente macro: Sub CopiarsoloVisibles() Dim escritorio, nombre, HojasVisibles() As String Dim HojasNoVisibles As Integer Dim Hojita As Worksheet Dim autoforma As Shape Application.ScreenUpdating = False escritorio = _ CreateObject("wscript.shell").specialfolders("desktop") & "\" nombre = ThisWorkbook.Sheets("Propuesta N°1").Range("d9").Value Menu = ThisWorkbook.Name HojasNoVisibles = 0 For Each Hojita In Sheets If Hojita.Visible = False Then HojasNoVisibles = HojasNoVisibles + 1 End If Next Hojita ReDim HojasVisibles(1 To Sheets.Count - HojasNoVisibles) For Each Hojita In Sheets If Hojita.Visible = True Then i = i + 1: HojasVisibles(i) = Hojita.Name End If Next Hojita Workbooks(Menu).Sheets(HojasVisibles).Copy Set l2 = ActiveWorkbook With l2 .Activate For Each Hojita In Sheets For Each autoforma In Hojita.Shapes If Mid(autoforma.Name, 1, 6) = "Button" Then _ autoforma.Delete Next autoforma With Hojita .UsedRange.Copy .UsedRange.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False .Select .Range("A1").Select End With Next Hojita .SaveAs escritorio & nombre & ".xlsx" .Close End With Application.ScreenUpdating = True End Sub [/CODE] Atte. joshua
  8. Saludos. Prueba con la siguiente macro: Sub copiahojaseimagen() Dim escritorio, nombre, HojasVisibles() As String Dim HojasNoVisibles As Integer Dim Hojita As Worksheet Dim autoforma As Shape Application.ScreenUpdating = False escritorio = _ CreateObject("wscript.shell").specialfolders("desktop") & "\" nombre = ThisWorkbook.Sheets("Propuesta N°1").Range("d9").Value Menu = ThisWorkbook.Name HojasNoVisibles = 0 For Each Hojita In Sheets If Hojita.Visible = False Then HojasNoVisibles = HojasNoVisibles + 1 End If Next Hojita ReDim HojasVisibles(1 To Sheets.Count - HojasNoVisibles) For Each Hojita In Sheets If Hojita.Visible = True Then i = i + 1: HojasVisibles(i) = Hojita.Name End If Next Hojita Workbooks(Menu).Sheets(HojasVisibles).Copy Set l2 = ActiveWorkbook With l2 .Activate For Each Hojita In Sheets For Each autoforma In Hojita.Shapes If Mid(autoforma.Name, 1, 6) = "Button" Then _ autoforma.Delete Next autoforma Next Hojita .SaveAs escritorio & nombre & ".xlsx" .Close End With Application.ScreenUpdating = True End Sub [/CODE] Atte. joshua
  9. Saludos. El codigo del Maestro Macro Antonio me a funcionado de la siguiente forma: Dim Valor1 As Double Private Sub ComboBox1_Change() If IsNumeric(ComboBox1) Then Valor1 = ComboBox1 * 10 ComboBox1 = Valor1 & "%" End If End Sub [/CODE] Atte. joshua
  10. Saludos. No se si querias el comentario en cada celda o en la primera o en la ultima celda coloreada, la acomode para que se insertara el comentario en cada celda con las fechas de reserva. Sub ColoreaRango_GP() On Error Resume Next With Application .ScreenUpdating = False vnh = .WorksheetFunction.Match(Range("D14"), Columns(1), 0) vpf = .WorksheetFunction.Match(Range("C16"), Rows(1), 0) vsf = .WorksheetFunction.Match(Range("D16"), Rows(1), 0) Set Rango = Range(Cells(vnh, vpf), Cells(vnh, vsf)) vb = Rango.Interior.ColorIndex Rango.Interior.ColorIndex = VBA.IIf(vb = -4142, 3, -4142) For i = vpf To vsf With Cells(vnh, i) .ClearComments .AddComment .Comment.Text "DATOS DE RESERVA" & Chr(10) & Range("C16") & " " & Range("D16") .Comment.Font.Name = "Comic Sans MS" End With Next i Set Rango = Nothing .ScreenUpdating = True End With On Error GoTo 0 End Sub [/CODE] Atte. joshua
  11. Saludos. Pon en el rango de celdas los valores como numeros y en el combobox. ComboBox1.Value = Format(Val(ComboBox1.Text) / 100, "00 %")[/CODE] En un boton [CODE]MsgBox 500 * Val(ComboBox1.Text) / 100[/CODE] Atte. joshua
  12. Saludos. El motivo por el cual no te deja copiar las hojas la desconosco esperemos que uno de los Maestros nos despeje la duda, por lo pronto te he acondicionado la macro para que genere el libro con la primera hoja data y con un bucle se agregan las demas, espero te sirva. Private Sub btnGenerarLiq_Click() Dim Archivo, Ruta, Carpeta, Destino, _ Titulo, Menu As String Dim i As Integer Dim Hojas, Hojita Titulo = "Liquidación de Caja Chica" Menu = ActiveWorkbook.Name Archivo = "Liquidación de Caja Chica del " & Format(Date, "dd-mm-yyyy") Ruta = ThisWorkbook.Path Carpeta = "Liquidaciones de Caja Chica" Destino = Ruta & "\" & Carpeta If Dir(Ruta, vbDirectory + vbHidden) <> "" Then If Dir(Destino, vbDirectory + vbHidden) = "" Then MkDir Destino End If End If Application.ScreenUpdating = False If MsgBox("¿Desea generar su liquidación con fecha " & _ Format(Date, "dd-mm-yyyy"), vbQuestion + vbYesNo, Titulo) = vbYes Then Hoja6.Visible = True Hoja6.Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Destino & "\" & Archivo & ".pdf" _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False Hoja2.Visible = True Hoja7.Visible = True Sheets("Data").Copy Set wb = ActiveWorkbook With wb .SaveAs Destino & "\" & Archivo & ".xlsx" .Save End With With Workbooks(Menu) .Activate Hojas = "Liquidación,Proveedores" Hojita = Split(Hojas, ",") For i = 0 To UBound(Hojita) .Sheets(Hojita(i)).Copy After:=Workbooks(Archivo & ".xlsx").Sheets(i + 1) Next i End With With Workbooks(Archivo & ".xlsx") Sheets(Array("Data", "Proveedores")).Visible = False .Save .Close End With MsgBox "Se generaron dos archivos con fecha " & Format(Date, "dd-mm-yyyy") & "," & vbCrLf _ & " un archivo PDF para impresión y visualización y " & vbCrLf & _ "un archivo XLSX para enviar a Contabilidad en la ruta" & vbCrLf & _ Destino, vbOKOnly, "Atención" Hoja2.Visible = False Hoja6.Visible = False Hoja7.Visible = False Hoja1.Select Else Exit Sub End If End Sub [/CODE] Atte. joshua
  13. Saludos. Fue una pregunta si te das cuenta en el libro gastos se van acumulando los gastos es decir sumando quieres que se haga lo mismo con el libro bancos. Atte. joshua
  14. Saludos. Adjunta un archivo con datos para poder hacer las pruebas. Atte. joshua
  15. Saludos. Lo del libro bancos se trabajara igual que el libro gastos o los registros seran individuales. Atte. joshua
×
×
  • Create New...

Important Information

Privacy Policy