aide macro déplacer hyperlien si

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

Bonjour
Comme les devis sont nettements moindre que les factures, je comptais laisser le fichier " paramètres" là où il est. et quand je fais les devis j' ouvre automatiquement le fichier " FACT BASE". siCe n' est pas possible de faire comme ça, c' est pas plus dérangeant que ça car je pense que le plus important c'est de regrouper les données pour ne pas qu'il y ait de doublons ou erreurs.
 

Yaloo

XLDnaute Barbatruc
Re : aide macro déplacer hyperlien si

Bonjour André,

Voici tes 2 fichiers modifiés :

- Suppression de "Paramètres" dans DEVIS, tu n'as qu'une base dans FACTURE
- Ouverture du fichier FACTURE à l'ouverture du fichier DEVIS
- Changement dans UserForm2 avec With ThisWorkbook.Sheets("Paramètres") à la place de With Sheets("Paramètres"), comme ça les données sont prises dans le classeur qui contient l'UserForm, donc FACTURE.
- Suppression des formules pour l'adresse, code postal etc...
- Ajout de ligne (dans UserForm2) permettant de copier l'adresse, code postal etc... dans ta feuille active (soit devis soit facture)

A+

Martial
 

Fichiers joints

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

bonjour
j'ai beau regarder j'y vois rien , qu'as tu fais pour que ça marche? de plus je voulais, tant qu'à faire , me servir de la liste des articles . mais rien à faire je vois même pas un bout de code à part le
Sub Load_Demandes()
UserForm2.Show
ActiveWindow.DisplayWorkbookTabs = False
End Sub
j'ai recopier en mettant UserForm3.show .....décidément....
 

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

en copiant collant et en juxtaposant j' ai enfin réussi à comprendre les codes
laborieux... enfin j'ai réussi à faire de même avec la liste des articles
Un grand merci, j'y ait passé depuis ce matin à chercher à le faire, cela me permet, au moins de comprendre ce que tu me fais et aussi parceque je crois à chaque fois que je vais y arriver tout seul !!!en tous les cas sache que ce qu'on propose sur le net c' est franchement pas comparable avec tes codes "simplement" dit. les autres c' est uzine à gaz.
 

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

Encore moi
Quand je clique sur le bouton pour faire appel à la liste (load...), cela m'enlève les onglets et je dois à chaque fois repartir sur
"fichier", "options", etc pour réaficher les onglets. faut il modifier un chouia ?
J'en profite pour te demander, je l'esperère une dernière chose :
pour passer du devis en facturation, le plus simplement possible j'ai 3constantes :
1)l' intitulé (noms adresse etc
2)la tableau intérieur
3) l'incrémentation facture avec la date
merci en espérant que se sera ok
 

Yaloo

XLDnaute Barbatruc
Re : aide macro déplacer hyperlien si

Re,

Pour les onglets, c'est normal puisque lorsque tu lances la macro Load_Demandes, après l'ouverture de l'UserForm2 tu as cette ligne
ActiveWindow.DisplayWorkbookTabs = False
cela te cache les onglets. Soit tu remplaces False par True soit tu supprimes complètement cette ligne, qui n'a rien à voir avec l'envoi de données.

Pour transformer le devis en facture, à mon sens :

- Tu copies la feuille DEVIS dans le classeur FACTURE.
- Tu copies ton N° de facture (Num_Fact) dans la feuille ajoutée.
- Tu renommes ta feuille avec ton N° de facture
- Tu incrémente ton N° de facture (Num_Fact)
- Tu fermes DEVIS
- Tu imprimes ta Facture.

Avec quelques chose comme ça (à mettre dans le fichier FACTURE mais à lancer avec un bouton dans DEVIS) :
VB:
Sub Transfert_devis()
    ActiveSheet.Move After:=Workbooks("BASE FACT.xlsm").Sheets(Sheets.Count)
    Range("H17").FormulaR1C1 = [Num_Fact]
    ActiveSheet.Name = [Num_Fact]
    [Num_Fact] = [Num_Fact] + 1
    Windows("DEVIS ORIGINAL.xlsm").Activate
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub
A+

Martial
 

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

Bonjour
Encore merci pour hier
j'ai donc tout réadapter sur mes originaux et c nickel
pour la dernière étape j' ai repris la base de laacro juste en haut :
Sub Transfert_devis()

ActiveSheet.Copy After:=Workbooks("BASE FACT.xlsm").Sheets(Sheets.Count)

'recupération du numéro de devis sur h19
Range("H19") = Range("H17")

'Range("H17").FormulaR1C1 = [Num_Fact] + 1
Range("h17").FormulaR1C1 = Year(Now) & Format(Range("Num_Fact") + 1, "000")
Range("h18") = Format(Now, "d-mmm-yy")

Range("G17") = Sheets("D-fact froid").Range("G17")
Range("G19") = Sheets("D-fact froid").Range("G19")
'renommer onglet avec numero facture
ActiveSheet.Name = Format(Range("Num_Fact") + 1, "000")
' APPELATION DEVIS CLIM EN FACTURE
ActiveSheet.Shapes.Range(Array("Round Diagonal Corner Rectangle 5")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "FACTURE "
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 9). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 9).Font
.Bold = msoTrue
.Caps = msoNoCaps
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Shadow.Type = msoShadow21
.Shadow.Visible = msoTrue
.Shadow.Style = msoShadowStyleOuterShadow
.Shadow.Blur = 6.2992125984
.Shadow.OffsetX = 0.3292235064
.Shadow.OffsetY = 3.1323524264
.Shadow.RotateWithShape = msoTrue
.Shadow.ForeColor.RGB = RGB(0, 0, 0)
.Shadow.Transparency = 0.6999999881
.Shadow.Size = 100
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.Fill.ForeColor.TintAndShade = 0.1000000238
.Fill.ForeColor.Brightness = 0
.Fill.BackColor.ObjectThemeColor = msoThemeColorAccent6
.Fill.BackColor.TintAndShade = 0.1000000238
.Fill.BackColor.Brightness = 0
.Fill.TwoColorGradient msoGradientHorizontal, 3
.Size = 20
.Line.Visible = msoFalse
.Name = "+mn-lt"
.Spacing = 0
End With

ATTENTION A PARTIR D' ICI C'EST DES ESSAIS EN '

'For i = 7 To Sheets.Count




'changement de devis en facture
' Sheets("D-FACT FROID").Select
' Selection.Copy
'Sheets("214").Select
'ActiveSheet.Paste
'changement N° de devis en suite devis
'Sheets("D-FACT FROID").Select
' Range("G19").Select
' Application.CutCopyMode = False
'Selection.Copy
'For i = 7 To Sheets.Count
'Sheets("i").Select
' Sheets(Sheets.Count).Select
'Range("G19").Select
' ActiveSheet.Paste
' ActiveSheet.Name = [Num_Fact]
' [Num_Fact] = [Num_Fact] + 1
'Windows("BASE DEVIS.xlsm").Activate
' ActiveWorkbook.Save
' ActiveWindow.Close


' Rows("48:57").Select
'Selection.RowHeight = 10
' ActiveCell.Rows("1:10").EntireRow.Select
' With Selection.Font
' .Name = "Calibri"
' .Size = 9
' .Strikethrough = False
' .Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline = xlUnderlineStyleNone
' .ThemeColor = xlThemeColorLight1
' .TintAndShade = 0
' .ThemeFont = xlThemeFontMinor
' End With
' Range("A48:A57") = Sheets("D-fact froid").Range("A48:A57")
'Range("A48:A57").CopyMode.Range("A48:A57").Sheets ("D-fact froid")

' Range("48:57") = Sheets("D-FACT FROID").Rows("48:48")


'changement du texte en bas du devis passé en facture
Sheets("D-FACT FROID").Select
ActiveCell.Rows("1:10").EntireRow.Select
Selection.Copy
With SheetsName("Num_Fact") + 1, "000").Select
'With SheetsName = Format(Range("Num_Fact") + 1, "000").Select
'Sheets("336").Select
ActiveCell.Offset(-6, 0).Rows("1:1").EntireRow.Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=6

End WiTH
End Sub

ET LA DERNIERE COMMANDE QUE JE TE REPRENDS:
'changement du texte en bas du devis passé en facture
Sheets("D-FACT FROID").Select
ActiveCell.Rows("1:10").EntireRow.Select
Selection.Copy
With SheetsName("Num_Fact") + 1, "000").Select
'With SheetsName = Format(Range("Num_Fact") + 1, "000").Select
JE NE TROUVE PAS LA BONNE SYNTAXE, l' idée c' est que comme il n' accepte pas de faire Range (a48àA57)=comme D-Fact froid
c' est de faire un copier coller qui marche, et donc le coller sur la feuille qui correspond à ("Num_Fact") + 1
c'est trop bête tout à marché jusqu'à cette dernière étape !
 

Yaloo

XLDnaute Barbatruc
Re : aide macro déplacer hyperlien si

Bonjour André,

Pour copier un ensemble de ligne vers un autre, il faut faire :

ActiveSheet.Rows("1:10").Copy ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Rows("1:10")
On copie les lignes de 1 à 10 de la feuille active (il faut se trouver sur la feuille devis) dans le classeur qui contient la macro dans la dernière feuille aux lignes de 1 à 10


Toute ta macro me parait bien compliquée.

Si c'est plus simple pour toi, tu peux, peut-être, copier tes données de DEVIS (comme ci-dessus) dans ta feuille FACTURE puis lancer ta macro de validation de facture, de façon à incrémenter ton N° de facture et créer ta facture dans ton fichier.

A+

Martial
 

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

ça marche pas
jcmprends pas je ne sais pas si c' est du au chgt de format ( hauteur le ligne ou taille police à 9)
 

Fichiers joints

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

voici la macro propre
Sub Transfert_devis()

ActiveSheet.Copy After:=Workbooks("BASE FACT.xlsm").Sheets(Sheets.Count)

'recupération du numéro de devis sur h19
Range("H19") = Range("H17")
Range("h17").FormulaR1C1 = Year(Now) & Format(Range("Num_Fact") + 1, "000")
Range("h18") = Format(Now, "d-mmm-yy")
Range("G17") = Sheets("D-fact froid").Range("G17")
Range("G19") = Sheets("D-fact froid").Range("G19")
'changement du bas de feuilles des clauses
ActiveSheet.Rows("50:60").Copy ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Rows("50:60")

'renommer onglet avec numero facture
ActiveSheet.Name = Format(Range("Num_Fact") + 1, "000")

' APPELATION DEVIS CLIM EN FACTURE
ActiveSheet.Shapes.Range(Array("Round Diagonal Corner Rectangle 9")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "FACTURE "
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 9). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 9).Font
.Bold = msoTrue
.Caps = msoNoCaps
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Shadow.Type = msoShadow21
.Shadow.Visible = msoTrue
.Shadow.Style = msoShadowStyleOuterShadow
.Shadow.Blur = 6.2992125984
.Shadow.OffsetX = 0.3292235064
.Shadow.OffsetY = 3.1323524264
.Shadow.RotateWithShape = msoTrue
.Shadow.ForeColor.RGB = RGB(0, 0, 0)
.Shadow.Transparency = 0.6999999881
.Shadow.Size = 100
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.Fill.ForeColor.TintAndShade = 0.1000000238
.Fill.ForeColor.Brightness = 0
.Fill.BackColor.ObjectThemeColor = msoThemeColorAccent6
.Fill.BackColor.TintAndShade = 0.1000000238
.Fill.BackColor.Brightness = 0
.Fill.TwoColorGradient msoGradientHorizontal, 3
.Size = 20
.Line.Visible = msoFalse
.Name = "+mn-lt"
.Spacing = 0
End With
End Sub

ci joint les 2 onglets dans le meme fichier....
 

Fichiers joints

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

Bonjour encore une fois , à force de chercher voici comment j'ai trouvé :
Sub Transfert_devisCLIM()

ActiveSheet.Copy After:=Workbooks("BASE FACT.xlsm").Sheets("A-FACT CLIM")

'recupération du numéro de devis sur h19
Range("H19") = Range("H17")
Range("h17").FormulaR1C1 = Year(Now) & Format(Range("Num_Fact") + 1, "000")
Range("h18") = Format(Now, "d-mmm-yy")
Range("G17") = Sheets("D-fact froid").Range("G17")
Range("G19") = Sheets("D-fact froid").Range("G19")
'changement du bas de feuilles des clauses
Range("A46") = Sheets("A-FACT CLIM").Range("A46")
Range("A47") = Sheets("A-FACT CLIM").Range("A47")
Range("A48") = Sheets("A-FACT CLIM").Range("A48")
Range("A49") = Sheets("A-FACT CLIM").Range("A49")
Range("A50") = Sheets("A-FACT CLIM").Range("A50")
Range("A51") = Sheets("A-FACT CLIM").Range("A51")
Range("A52") = Sheets("A-FACT CLIM").Range("A52")
Range("A53") = Sheets("A-FACT CLIM").Range("A53")
Range("A54") = Sheets("A-FACT CLIM").Range("A54")
Range("A55") = Sheets("A-FACT CLIM").Range("A55")
Range("A56") = Sheets("A-FACT CLIM").Range("A56")
Range("A57") = Sheets("A-FACT CLIM").Range("A57")
Range("E49").ClearContents
Range("E49").Clear
Range("E49").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'renommer onglet avec numero facture
ActiveSheet.Name = Format(Range("Num_Fact") + 1, "000")
' APPELATION DEVIS CLIM EN FACTURE
En conclusion tout fonctionne ! Même en recreant les Userform avec les mêmes codes , juste le chemin d' acces qui renvoie à :
With Workbooks("BASE FACT.xlsm").Sheets("Paramètres")
Car pour remplir la fiche client ta solution en passant par macro "load" marchait, mais pour remplir chaque ligne du tableau la liste des articles, impossible. En ayant chaque classeur ses userform mais avec la même base de données tout est rentré dans l' ordre.
( dailleurs si tu as une solution pour que je puisse utiliser la molette de défilement à travers la boite de dialogue, j' ai rien trouvé sur le net )
En conclusion un grand merci encore une fois.
 

Yaloo

XLDnaute Barbatruc
Re : aide macro déplacer hyperlien si

Re,

Bon si tout fonctionne c'est parfait.
Pour la molette, je n'ai pas trouvé, c'est pour ça que la recherche est intéressante.

A+

Martial
 

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

je me doutais bien que si tu n' avais pas trouvé c'est qu'il y avait une très bonne raison ....!!!!
j'ai cherché au début du côté des codes vba
puis du côté modules liés à excel 2010 ( vb7) , là plus intérréssant : problèmes de compatibilités de version
et du côté microsoft : c' est encore pire !
en fait vb7 n' intègre pas la DLL et , à moins d' être programmeur style : Téléchargement de UTILISER LA ROULETTE DANS VB6 IDE (ADDIN)
ou http://www.excel-downloads.com/forum/20965-molette-inactive-dans-le-code-sous-vba.html
le intellipoint 4.12 version française n' est plus compatible avec nos windows à jour ( j'ai la version 9)
en résumé j' ai le même problème que Comment récupérer la molette de la souris dans l'éditeur ? mais j' ai pas compris sa solution que j' ai éssayé
C' est toujours pareil, je crois que se sera pas long à faire une petite recherche , puis , PAF ! c' est un labyrinthe !
Enfin c' était pour te réconforter !!!!
A bientôt
 

Yaloo

XLDnaute Barbatruc
Re : aide macro déplacer hyperlien si

Salut André,

Merci de me réconforter, mais je peux très bien vivre sans avoir la roulette dans VBA :p.

J'ai regardé les liens que tu proposes dans ton post, il me semble qu'ils sont tous pour une version antérieure et non celle fournie avec Excel 2010. Dommage !!!!

A+

Martial
 

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

Je m'en doute bien, que tu peux vivre sans. C' était un tout petit plus. mais la curiosité m'a ratrappé ! c' est pour cela que j'ai créé un nouveau post, beaucoup plus pour comprendre cette curiosité : tout le monde s' est cassé les dents sur VB6 et sur VB7 , le désert total , même sur le net. ou j' ai loupé le "truc" .
 

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

Hé Bé !
j'ai reçu une solution qui remplace largement la roulette : à chaque clic droit , me fait défilé suivant mon incrémentation, ma liste.
Dans mon userform, ma liste contient 13 lignes et bien à chaque clic, je passe au 13 lignes suivantes.
a rajouter à la suite des codes de l' userform en question
Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim v As Byte
v = 13 'pas de défilement
With ListBox1
.TopIndex = IIf(b = False, .TopIndex + v, IIf((.TopIndex - v) >= 0, .TopIndex - v, 0))
If (.TopIndex + v) > .ListCount Then
b = True
ElseIf (.TopIndex + v) <= v Then b = False
End If
End With
End Sub
et marche nickel !
 

systmd

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

Bonjour à tous

Voici un petit exemple pour la roulette .

Ne pas oublier la propriété TAG de la ListBox et le Unhook avant Fermeture de l'USF,
sinon plantage assuré.
 

Yaloo

XLDnaute Barbatruc
Re : aide macro déplacer hyperlien si

Bonjour systmd,

Chez moi, W7 Office 2010, ça ne fonctionne toujours pas.

A+
 

andrekn13

XLDnaute Occasionnel
Re : aide macro déplacer hyperlien si

bonjour
je reviens vers vous pour une petite aide en urgence
Suite ordi HS, j' ai besoin suivant ordi de faire une macro qui me permet de faire un pdf sur le bureau suivant l' ordi que j' utilise, sans à chaque fois changer l' adresse
Sub pdf()

Dim Fichier As String
Dim X As String
Dim Y As String
Dim Z As String

X = Range("E45").Value
Y = Range("E11").Value
Z = Range("H17").Value
Fichier = Z & " - " & Y & " - " & X & " € "

'sur ordi tour hs''ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\AK FROID\Desktop\COMPTA2013\LISTE FACTURES\" & Fichier, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
OpenAfterPublish:=False'

'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\HP AK FROID\Desktop\" & Fichier, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
OpenAfterPublish:=False'

'ORDI SAMSUNG'
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\AK\Desktop\" & Fichier, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
OpenAfterPublish:=False '


End Sub
MERCI ENCORE BEAUCOUP
 

Discussions similaires


Haut Bas